library(cluster)
library(dplyr)
library(ggplot2)
library(readr)
library(Rtsne)
library(NbClust)
library(factoextra)
library(purrr)
library(stringr)
library(expss)
library(skimr)
library(DataExplorer)
library(tidyr)
library(dummies)
library(sjmisc)
library(corrplot)
library(MASS)
ic_nd <- read.csv("ic_nd1.csv", header=TRUE) %>% dplyr::select(data_productividad_per,data_Tcamp ,
data_sumCOD,
data_sumHRSLB,
data_GRADO2,
data_sum_variedad_total_AL,
data_sum_variedad_total_CC,
data_sum_variedad_total_CP,
data_sum_variedad_total_JS,
data_sum_variedad_total_MG,
data_sum_variedad_total_RG,
data_sum_variedad_total_SG,
data_sum_variedad_total_TC,
data_sum_variedad_total_TM,
data_sum_variedad_total_VN,
data_sum_aux_bono_total,
data_sum_hora_extra,
data_n_lote,
data_n_fundo,
data_T_RangoEdad,
data_Testado_civil,
data_Tsexo,
data_T_numero_hijos,
data_dias_empresa,
data_Tedad,
data_numero_hijos,
data_pobreza,
data_n_variedad,
data_veces,
data_DEUDA_PROM_U6M,
data_PEOR_CALIF_U6M,
data_MODA_CALIF_U6M,
data_NRO_ENT_PROM_U6M,
data_TIPCRE_UM,
data_DIAS_ATRASO_PROM_U6M,
data_BANCARIZADO,
data_distancia,
data_import_unico,
data_total,
data_bono_produc,
data_otros_bono,
dummies_Tsexo_Mujer,data_numero_asistentes,
data_asistente_mediana_Tedad,
data_asistente_mediana_numero_hijos,
data_asistente_dias_empresa)%>% mutate(sede_cod='Ica')
ir_nd <- read.csv("ir_nd1.csv", header=TRUE) %>% dplyr::select(data_productividad_per,data_Tcamp ,
data_sumCOD,
data_sumHRSLB,
data_GRADO2,
data_sum_variedad_total_AL,
data_sum_variedad_total_CC,
data_sum_variedad_total_CP,
data_sum_variedad_total_JS,
data_sum_variedad_total_MG,
data_sum_variedad_total_RG,
data_sum_variedad_total_SG,
data_sum_variedad_total_TC,
data_sum_variedad_total_TM,
data_sum_variedad_total_VN,
data_sum_aux_bono_total,
data_sum_hora_extra,
data_n_lote,
data_n_fundo,
data_T_RangoEdad,
data_Testado_civil,
data_Tsexo,
data_T_numero_hijos,
data_dias_empresa,
data_Tedad,
data_numero_hijos,
data_pobreza,
data_n_variedad,
data_veces,
data_DEUDA_PROM_U6M,
data_PEOR_CALIF_U6M,
data_MODA_CALIF_U6M,
data_NRO_ENT_PROM_U6M,
data_TIPCRE_UM,
data_DIAS_ATRASO_PROM_U6M,
data_BANCARIZADO,
data_distancia,
data_import_unico,
data_total,
data_bono_produc,
data_otros_bono,
dummies_Tsexo_Mujer,data_numero_asistentes,
data_asistente_mediana_Tedad,
data_asistente_mediana_numero_hijos,
data_asistente_dias_empresa)%>% mutate(sede_cod='Ica')
pc_nd <- read.csv("pc_nd1.csv", header=TRUE) %>% dplyr::select(data_productividad_per,data_Tcamp ,
data_sumCOD,
data_sumHRSLB,
data_GRADO2,
data_sum_variedad_total_AL,
data_sum_variedad_total_CC,
data_sum_variedad_total_CP,
data_sum_variedad_total_JS,
data_sum_variedad_total_MG,
data_sum_variedad_total_RG,
data_sum_variedad_total_SG,
data_sum_variedad_total_TC,
data_sum_variedad_total_TM,
data_sum_variedad_total_VN,
data_sum_aux_bono_total,
data_sum_hora_extra,
data_n_lote,
data_n_fundo,
data_T_RangoEdad,
data_Testado_civil,
data_Tsexo,
data_T_numero_hijos,
data_dias_empresa,
data_Tedad,
data_numero_hijos,
data_pobreza,
data_n_variedad,
data_veces,
data_DEUDA_PROM_U6M,
data_PEOR_CALIF_U6M,
data_MODA_CALIF_U6M,
data_NRO_ENT_PROM_U6M,
data_TIPCRE_UM,
data_DIAS_ATRASO_PROM_U6M,
data_BANCARIZADO,
data_distancia,
data_import_unico,
data_total,
data_bono_produc,
data_otros_bono,
dummies_Tsexo_Mujer,data_numero_asistentes,
data_asistente_mediana_Tedad,
data_asistente_mediana_numero_hijos,
data_asistente_dias_empresa)%>% mutate(sede_cod='Piura')
pr_nd <- read.csv("pr_nd1.csv", header=TRUE) %>% dplyr::select(data_productividad_per,data_Tcamp ,
data_sumCOD,
data_sumHRSLB,
data_GRADO2,
data_sum_variedad_total_AL,
data_sum_variedad_total_CC,
data_sum_variedad_total_CP,
data_sum_variedad_total_JS,
data_sum_variedad_total_MG,
data_sum_variedad_total_RG,
data_sum_variedad_total_SG,
data_sum_variedad_total_TC,
data_sum_variedad_total_TM,
data_sum_variedad_total_VN,
data_sum_aux_bono_total,
data_sum_hora_extra,
data_n_lote,
data_n_fundo,
data_T_RangoEdad,
data_Testado_civil,
data_Tsexo,
data_T_numero_hijos,
data_dias_empresa,
data_Tedad,
data_numero_hijos,
data_pobreza,
data_n_variedad,
data_veces,
data_DEUDA_PROM_U6M,
data_PEOR_CALIF_U6M,
data_MODA_CALIF_U6M,
data_NRO_ENT_PROM_U6M,
data_TIPCRE_UM,
data_DIAS_ATRASO_PROM_U6M,
data_BANCARIZADO,
data_distancia,
data_import_unico,
data_total,
data_bono_produc,
data_otros_bono,
dummies_Tsexo_Mujer,data_numero_asistentes,
data_asistente_mediana_Tedad,
data_asistente_mediana_numero_hijos,
data_asistente_dias_empresa)%>% mutate(sede_cod='Piura')
Mode <- function(x) {
ux <- unique(x)
ux[which.max(tabulate(match(x, ux)))]
}
df<-rbind(ic_nd,pc_nd) %>% mutate(data_T_RangoEdad=case_when(data_T_RangoEdad=='21-25'~'MENOR A 30',
data_T_RangoEdad=='26-30'~'MENOR A 30',
data_T_RangoEdad=='Menos de 20'~'MENOR A 30',
data_T_RangoEdad=='31-35'~'DE 31 A 50',
data_T_RangoEdad=='36-40'~'DE 31 A 50',
data_T_RangoEdad=='41-50'~'DE 31 A 50',
data_T_RangoEdad=='Màs de 50'~'MAS DE 50',
TRUE ~ 'DE 31 A 50')) %>% mutate(data_GRADO2=case_when(data_GRADO2=='SUPERIOR INCOMPLETA'~'SUPERIOR - TECNICO',
data_GRADO2=='SUPERIOR COMPLETA'~'SUPERIOR - TECNICO',
data_GRADO2=='TECNICO IMCOMPLETA'~'SUPERIOR - TECNICO',
data_GRADO2=='TECNICO COMPLETA'~'SUPERIOR - TECNICO', TRUE ~ data_GRADO2
))
df1<-rbind(ir_nd,pr_nd) %>% mutate(data_T_RangoEdad=case_when(data_T_RangoEdad=='21-25'~'MENOR A 30',
data_T_RangoEdad=='26-30'~'MENOR A 30',
data_T_RangoEdad=='Menos de 20'~'MENOR A 30',
data_T_RangoEdad=='31-35'~'DE 31 A 50',
data_T_RangoEdad=='36-40'~'DE 31 A 50',
data_T_RangoEdad=='41-50'~'DE 31 A 50',
data_T_RangoEdad=='Màs de 50'~'MAS DE 50',
TRUE ~ 'DE 31 A 50')) %>% mutate(data_GRADO2=case_when(data_GRADO2=='SUPERIOR INCOMPLETA'~'SUPERIOR - TECNICO',
data_GRADO2=='SUPERIOR COMPLETA'~'SUPERIOR - TECNICO',
data_GRADO2=='TECNICO IMCOMPLETA'~'SUPERIOR - TECNICO',
data_GRADO2=='TECNICO COMPLETA'~'SUPERIOR - TECNICO', TRUE ~ data_GRADO2
))
glimpse(df)
Rows: 22,079 Columns: 47 $ data_productividad_per <dbl> 2.803874, 9.076923, 1.583333, 7.58… $ data_Tcamp <int> 18, 19, 20, 18, 19, 20, 19, 18, 20… $ data_sumCOD <int> 579, 59, 19, 91, 8, 401, 337, 380,… $ data_sumHRSLB <dbl> 206.5, 6.5, 12.0, 12.0, 2.5, 158.0… $ data_GRADO2 <chr> "PRIMARIA COMPLETA", "SECUNDARIA C… $ data_sum_variedad_total_AL <dbl> 815.13, 0.00, 0.00, 0.00, 0.00, 40… $ data_sum_variedad_total_CC <dbl> 0.00, 0.00, 0.00, 0.00, 0.00, 0.00… $ data_sum_variedad_total_CP <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0… $ data_sum_variedad_total_JS <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0… $ data_sum_variedad_total_MG <dbl> 400.80, 0.00, 0.00, 16.40, 0.00, 2… $ data_sum_variedad_total_RG <dbl> 0.00, 0.00, 36.18, 0.00, 0.00, 0.0… $ data_sum_variedad_total_SG <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0… $ data_sum_variedad_total_TC <dbl> 0.00, 0.00, 0.00, 0.00, 0.00, 0.00… $ data_sum_variedad_total_TM <dbl> 0.00, 35.07, 104.92, 0.00, 14.40, … $ data_sum_variedad_total_VN <dbl> 45.09, 0.00, 0.00, 0.00, 0.00, 0.0… $ data_sum_aux_bono_total <dbl> 324.66, 0.00, 2.06, 1.19, 0.00, 34… $ data_sum_hora_extra <dbl> 70.25, 35.07, 0.00, 0.00, 14.40, 4… $ data_n_lote <int> 5, 3, 2, 2, 1, 8, 7, 6, 3, 2, 2, 2… $ data_n_fundo <int> 3, 1, 2, 2, 1, 4, 4, 3, 2, 1, 2, 1… $ data_T_RangoEdad <chr> "MAS DE 50", "DE 31 A 50", "MAS DE… $ data_Testado_civil <chr> "Casado(a)/conviviente/unionlibre"… $ data_Tsexo <chr> "Hombre", "Mujer", "Hombre", "Homb… $ data_T_numero_hijos <chr> "sin hijos", "sin hijos", "sin hij… $ data_dias_empresa <int> 8068, 8104, 7731, 7731, 7261, 7366… $ data_Tedad <dbl> 69, 45, 63, 60, 67, 55, 54, 53, 63… $ data_numero_hijos <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 2, 2… $ data_pobreza <dbl> 41.25, 45.90, 45.90, 45.90, 45.90,… $ data_n_variedad <int> 3, 1, 2, 2, 1, 3, 4, 3, 2, 1, 2, 1… $ data_veces <int> 3, 1, 3, 3, 1, 4, 4, 4, 1, 2, 2, 2… $ data_DEUDA_PROM_U6M <dbl> 12419.44, NA, NA, 1153.34, NA, 932… $ data_PEOR_CALIF_U6M <chr> "2.DEFICIENTE", "8.SIN CALIFICACIO… $ data_MODA_CALIF_U6M <chr> "0.NORMAL", NA, NA, "0.NORMAL", NA… $ data_NRO_ENT_PROM_U6M <dbl> 1.00, NA, NA, 1.00, NA, 1.00, 1.00… $ data_TIPCRE_UM <chr> "CONSUMO NO REVOLVENTE", NA, NA, "… $ data_DIAS_ATRASO_PROM_U6M <dbl> 2.17, NA, NA, 0.00, NA, 0.00, 0.00… $ data_BANCARIZADO <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1… $ data_distancia <dbl> 2692.687, 4795.824, 4795.824, 4795… $ data_import_unico <dbl> 893.80, 0.00, 141.10, 15.21, 0.00,… $ data_total <dbl> 1288.71, 35.07, 143.16, 16.40, 14.… $ data_bono_produc <dbl> 296.97, 0.00, 0.00, 1.19, 0.00, 11… $ data_otros_bono <dbl> 27.69, 0.00, 2.06, 0.00, 0.00, 231… $ dummies_Tsexo_Mujer <int> 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0… $ data_numero_asistentes <int> 2, 3, 1, 2, 1, 3, 4, 1, 2, 1, 1, 1… $ data_asistente_mediana_Tedad <dbl> 32.0, 33.0, 35.0, NA, 49.0, 33.0, … $ data_asistente_mediana_numero_hijos <dbl> 1.0, 2.0, 1.0, NA, 1.0, 0.0, 0.0, … $ data_asistente_dias_empresa <dbl> NA, NA, 2565, NA, 3627, NA, NA, NA… $ sede_cod <chr> "Ica", "Ica", "Ica", "Ica", "Ica",…
# BASE DE DATOS
#--------------
# SELECCIÓN DE VARIABLES
masterip_g1 <- df %>% dplyr::select(data_productividad_per,data_Tcamp,
data_sumCOD,
data_sumHRSLB,
data_GRADO2,
data_sum_variedad_total_AL,
data_sum_variedad_total_CC,
data_sum_variedad_total_CP,
data_sum_variedad_total_JS,
data_sum_variedad_total_MG,
data_sum_variedad_total_RG,
data_sum_variedad_total_SG,
data_sum_variedad_total_TC,
data_sum_variedad_total_TM,
data_sum_variedad_total_VN,
data_sum_aux_bono_total,
data_sum_hora_extra,
data_n_lote,
data_n_fundo,
data_T_RangoEdad,
data_Testado_civil,
data_Tsexo,
data_T_numero_hijos,
data_dias_empresa,
data_Tedad,
data_numero_hijos,
data_pobreza,
data_n_variedad,
data_veces,
data_DEUDA_PROM_U6M,
data_PEOR_CALIF_U6M,
data_MODA_CALIF_U6M,
data_NRO_ENT_PROM_U6M,
data_TIPCRE_UM,
data_DIAS_ATRASO_PROM_U6M,
data_BANCARIZADO,
data_distancia,
data_import_unico,
data_total,
data_bono_produc,
data_otros_bono,
dummies_Tsexo_Mujer,sede_cod,data_numero_asistentes,
data_asistente_mediana_Tedad,
data_asistente_mediana_numero_hijos,
data_asistente_dias_empresa)
###############################################################################################
###################################### ANALISIS CLUSTER #######################################
###############################################################################################
masterip_g11 <- masterip_g1 %>% dplyr::select(data_productividad_per,
data_bono_produc,
data_otros_bono,
data_import_unico,
data_dias_empresa,
data_Tedad,
data_numero_hijos,
data_pobreza,
data_veces,
dummies_Tsexo_Mujer,
data_numero_asistentes,
data_asistente_mediana_Tedad,
data_asistente_mediana_numero_hijos,
data_asistente_dias_empresa
)
masterip_g11 <- na.omit(masterip_g11)
masterip_g11 <- masterip_g1%>% dplyr::select(data_productividad_per,
data_import_unico,
data_dias_empresa,
data_Tedad,
data_numero_hijos,
data_pobreza,
data_veces,
dummies_Tsexo_Mujer)
masterip_g11<-masterip_g11 %>% mutate_if(is.numeric, funs(replace(.,is.na(.), median(., na.rm = TRUE)))) %>% mutate_if(is.character, funs(replace(.,is.na(.), Mode(na.omit(.)))))
#######################################
# Cluster de Partición - No Jerárquicos
########################################
# Usando el criterio del Gráfico de Silueta
set.seed(123)
a<-fviz_nbclust(masterip_g11, FUNcluster = kmeans, method = "silhouette", k.max = 20) +
labs(subtitle = "Silhouette method")
a
b<-a$data%>%slice(which.max(y))
b<-as.numeric(b[1,1])
paste("Numero de cluster=", b)
k <- b
set.seed(1234)
km <- kmeans(masterip_g11, k, iter.max = 1000, nstart=10)
paste("SS between cluster=", (km$betweens/km$totss) *100, "%")
# Para la validación de los cluster usamos Análisis discriminante
scores_cluster <- km$cluster %>% as.data.frame()
colnames(scores_cluster) <- c("cluster")
masterip_g11_final <- cbind(masterip_g11,scores_cluster) %>% as.data.frame()
modelo_lda <- lda(cluster~., data=masterip_g11_final)
n <- ncol(masterip_g11_final)
predicciones <- predict(object = modelo_lda, newdata=masterip_g11_final[,-n])
#table(masterip_g11_final$cluster, predicciones$class, dnn=c("Clase real", "Clase predicha"))
training_error <- mean(masterip_g11_final$cluster != predicciones$class)*100
paste("Error de classification=", training_error, "%")
# Análisis de correlación
# Visualización de las soluciones usando ACP
library(factoextra)
fviz_cluster(km,data=masterip_g11_final,ellipse.type = "convex") +
theme_classic()
corrplot(cor(masterip_g11), order = "hclust", tl.col='black', tl.cex=1) #Gráfico de las correlaciones
masterip_g11_final <- masterip_g11 %>% mutate(cluster=km$cluster )
masterip_g1$cluster <- masterip_g11_final$cluster
masterip_g1 %>% tab_cols(total(),cluster) %>% tab_cells('Sede'=sede_cod) %>% tab_stat_cpct(total_row_position = "above")%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
tab_stat_median()%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
tab_stat_max()%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
tab_stat_min() %>%tab_cells('Sexo'=data_Tsexo,'Rango de edades'=data_T_RangoEdad,'Grado de Instruccion'=data_GRADO2,'Estado Civil'=data_Testado_civil,'Tenencia de Hijos'=data_T_numero_hijos,'Cantidad de Campañas'=data_veces) %>% tab_stat_cpct(total_row_position = "above") %>%
tab_cells('Edad'=data_Tedad,'Numero de hijos'=data_numero_hijos,'Porcentaje de Pobreza'=data_pobreza,'Dias en la Empresa'=data_dias_empresa, 'Distancia que recorre en metros'=data_distancia) %>%
tab_stat_mean() %>%
tab_cells('Otros Bonos'=data_otros_bono,'Numero de Lotes'=data_n_lote,'Numero de fundos'=data_n_fundo,'Numero de variedad'=data_n_variedad) %>%
tab_stat_median() %>%
tab_cells('Importe unico'=data_import_unico,'Importe Horas extra'=data_sum_hora_extra,'Bono total'=data_sum_aux_bono_total,
'Bono Produccion'=data_bono_produc,'Otros bonos'=data_otros_bono) %>%
tab_stat_mean() %>%
tab_cells('Bancarizado'=data_BANCARIZADO) %>%
tab_stat_mean() %>%
tab_cells('Peor calificación'=data_PEOR_CALIF_U6M,'Moda de Calificación'=data_MODA_CALIF_U6M,data_TIPCRE_UM) %>%
tab_stat_cpct(total_row_position = "above") %>%
tab_cells('Deuda Promedio'=data_DEUDA_PROM_U6M,'Promedio de Dias de atraso'=data_NRO_ENT_PROM_U6M,'Promedio de Dias de atraso'=data_DIAS_ATRASO_PROM_U6M) %>%
tab_stat_mean() %>%
tab_pivot() %>%
set_caption("Tabla describe cluster")
masterip_g1 %>% mutate(clus_camp=paste(cluster,'-',data_Tcamp)) %>% tab_cols(total(),clus_camp) %>% tab_cells('Importe unico'=data_import_unico,'Importe Horas extra'=data_sum_hora_extra,'Bono total'=data_sum_aux_bono_total,
'Bono Produccion'=data_bono_produc,'Otros bonos'=data_otros_bono) %>%
tab_stat_mean() %>%
tab_pivot() %>%
set_caption("Tabla describe cluster")
Warning message: “Quick-TRANSfer stage steps exceeded maximum (= 1103950)” Warning message: “Quick-TRANSfer stage steps exceeded maximum (= 1103950)”
| Tabla describe cluster | |||||||
| #Total | cluster | ||||||
|---|---|---|---|---|---|---|---|
| 1 | 2 | 3 | |||||
| Sede | #Total cases | 22079 | 544 | 5747 | 15788 | ||
| Ica | 60.9 | 71.0 | 70.7 | 57.0 | |||
| Piura | 39.1 | 29.0 | 29.3 | 43.0 | |||
| Productividad | Median | 2.7 | 2.9 | 3.1 | 2.5 | ||
| Producción | Median | 276.0 | 74.0 | 999.0 | 129.0 | ||
| Horas Laboraras | Median | 101.0 | 26.0 | 314.5 | 54.0 | ||
| Productividad | Max. | 331.1 | 85.5 | 134.1 | 331.1 | ||
| Producción | Max. | 5657.0 | 3104.0 | 4697.0 | 5657.0 | ||
| Horas Laboraras | Max. | 711.8 | 641.5 | 711.8 | 626.2 | ||
| Productividad | Min. | 0.2 | 0.2 | 0.4 | 0.2 | ||
| Producción | Min. | 1.0 | 1.0 | 3.0 | 1.0 | ||
| Horas Laboraras | Min. | 0.5 | 1.0 | 4.0 | 0.5 | ||
| Sexo | #Total cases | 22079 | 544 | 5747 | 15788 | ||
| Hombre | 35.5 | 59.6 | 17.1 | 41.4 | |||
| Mujer | 64.5 | 40.4 | 82.9 | 58.6 | |||
| Rango de edades | #Total cases | 22079 | 544 | 5747 | 15788 | ||
| DE 31 A 50 | 43.3 | 71.7 | 51.9 | 39.1 | |||
| MAS DE 50 | 6.2 | 18.6 | 7.9 | 5.2 | |||
| MENOR A 30 | 50.5 | 9.7 | 40.2 | 55.7 | |||
| Grado de Instruccion | #Total cases | 17560 | 544 | 5016 | 12000 | ||
| ILETRADO | 2.7 | 2.0 | 3.1 | 2.5 | |||
| PRIMARIA COMPLETA | 13.8 | 17.8 | 14.6 | 13.2 | |||
| PRIMARIA INCOMPLETA | 8.5 | 6.8 | 7.5 | 8.9 | |||
| SECUNDARIA COMPLETA | 42.3 | 50.9 | 44.3 | 41.1 | |||
| SECUNDARIA IMCOMPLETA | 30.7 | 16.2 | 28.5 | 32.3 | |||
| SUPERIOR - TECNICO | 2.1 | 6.2 | 2.0 | 1.9 | |||
| Estado Civil | #Total cases | 22079 | 544 | 5747 | 15788 | ||
| Casado(a)/conviviente/unionlibre | 8.0 | 20.2 | 9.0 | 7.2 | |||
| Divorciado(a)/separado(a) | 0.1 | 0.1 | 0.1 | ||||
| Soltero(a) | 91.8 | 79.8 | 90.6 | 92.7 | |||
| Viudo(a) | 0.1 | 0.2 | 0.1 | ||||
| Tenencia de Hijos | #Total cases | 22079 | 544 | 5747 | 15788 | ||
| con hijos | 55.3 | 32.4 | 71.0 | 50.4 | |||
| sin hijos | 44.7 | 67.6 | 29.0 | 49.6 | |||
| Cantidad de Campañas | #Total cases | 22079 | 544 | 5747 | 15788 | ||
| 1 | 52.8 | 16.2 | 29.5 | 62.6 | |||
| 2 | 21.3 | 20.6 | 23.4 | 20.6 | |||
| 3 | 11.9 | 21.5 | 18.6 | 9.2 | |||
| 4 | 8.2 | 20.4 | 15.1 | 5.3 | |||
| 5 | 5.7 | 21.3 | 13.3 | 2.4 | |||
| Edad | Mean | 32.2 | 41.5 | 34.3 | 31.0 | ||
| Numero de hijos | Mean | 0.8 | 0.5 | 1.0 | 0.7 | ||
| Porcentaje de Pobreza | Mean | 33.6 | 35.2 | 33.9 | 33.4 | ||
| Dias en la Empresa | Mean | 224.6 | 2921.1 | 165.3 | 153.2 | ||
| Distancia que recorre en metros | Mean | 93542.7 | 20357.6 | 65076.9 | 109076.5 | ||
| Otros Bonos | Median | 3.5 | 16.3 | 80.0 | 0.0 | ||
| Numero de Lotes | Median | 5.0 | 2.0 | 12.0 | 3.0 | ||
| Numero de fundos | Median | 2.0 | 2.0 | 4.0 | 2.0 | ||
| Numero de variedad | Median | 2.0 | 2.0 | 3.0 | 2.0 | ||
| Importe unico | Mean | 623.9 | 464.7 | 1518.2 | 303.9 | ||
| Importe Horas extra | Mean | 18.4 | 30.1 | 49.9 | 6.5 | ||
| Bono total | Mean | 178.6 | 175.9 | 473.1 | 71.5 | ||
| Bono Produccion | Mean | 126.5 | 133.1 | 362.7 | 40.3 | ||
| Otros bonos | Mean | 55.3 | 47.3 | 120.6 | 31.8 | ||
| Bancarizado | Mean | 0.7 | 0.9 | 0.7 | 0.7 | ||
| Peor calificación | #Total cases | 22074 | 544 | 5747 | 15783 | ||
| 0.NORMAL | 19.2 | 43.0 | 20.0 | 18.1 | |||
| 1.CPP | 3.7 | 5.0 | 4.3 | 3.4 | |||
| 2.DEFICIENTE | 1.6 | 2.0 | 1.5 | 1.5 | |||
| 3.DUDOSO | 2.3 | 2.9 | 2.7 | 2.1 | |||
| 4.EN PERDIDA | 21.7 | 17.3 | 19.4 | 22.8 | |||
| 8.SIN CALIFICACION | 51.5 | 29.8 | 52.1 | 52.0 | |||
| Moda de Calificación | #Total cases | 10648 | 375 | 2732 | 7541 | ||
| 0.NORMAL | 53.1 | 72.8 | 58.1 | 50.3 | |||
| 1.CPP | 2.1 | 1.6 | 2.0 | 2.1 | |||
| 2.DEFICIENTE | 1.0 | 1.1 | 1.1 | 0.9 | |||
| 3.DUDOSO | 2.8 | 2.1 | 2.9 | 2.7 | |||
| 4.EN PERDIDA | 41.1 | 22.4 | 35.9 | 43.9 | |||
| data_TIPCRE_UM | #Total cases | 7461 | 319 | 2007 | 5135 | ||
| CONSUMO NO REVOLVENTE | 48.3 | 75.2 | 49.6 | 46.1 | |||
| CONSUMO REVOLVENTE | 10.6 | 11.9 | 10.5 | 10.6 | |||
| HIPOTECARIOS PARA VIVIENDA | 0.5 | 0.9 | 0.6 | 0.4 | |||
| MICROEMPRESAS | 39.0 | 11.6 | 37.9 | 41.1 | |||
| PEQUENAS EMPRESAS | 1.6 | 0.3 | 1.3 | 1.8 | |||
| Deuda Promedio | Mean | 4094.9 | 8033.5 | 4145.1 | 3848.5 | ||
| Promedio de Dias de atraso | Mean | 1.5 | 1.6 | 1.5 | 1.5 | ||
| 66.7 | 62.4 | 69.8 | 65.8 | ||||
| Tabla describe cluster | |||||||||||||
| #Total | clus_camp | ||||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 - 18 | 1 - 19 | 1 - 20 | 2 - 18 | 2 - 19 | 2 - 20 | 3 - 18 | 3 - 19 | 3 - 20 | |||||
| Importe unico | Mean | 623.9 | 471.2 | 475.2 | 442.9 | 1249.5 | 1615.8 | 1483.9 | 253.1 | 295.9 | 332.3 | ||
| Importe Horas extra | Mean | 18.4 | 36.1 | 29.2 | 27.1 | 72.7 | 45.2 | 46.6 | 11.2 | 6.4 | 4.8 | ||
| Bono total | Mean | 178.6 | 113.9 | 146.5 | 268.9 | 166.0 | 304.6 | 916.4 | 33.8 | 45.8 | 114.9 | ||
| Bono Produccion | Mean | 126.5 | 92.7 | 124.9 | 176.2 | 135.0 | 248.3 | 673.4 | 31.2 | 39.0 | 45.3 | ||
| Otros bonos | Mean | 55.3 | 21.2 | 25.4 | 101.6 | 31.1 | 62.0 | 266.3 | 2.7 | 7.3 | 70.7 | ||
# PARA 4 CLUSTERES
set.seed(1234)
km <- kmeans(masterip_g11, 4, iter.max = 1000, nstart=10)
paste("SS between cluster=", (km$betweens/km$totss) *100, "%")
# Para la validación de los cluster usamos Análisis discriminante
scores_cluster <- km$cluster %>% as.data.frame()
colnames(scores_cluster) <- c("cluster")
masterip_g11_final <- cbind(masterip_g11,scores_cluster) %>% as.data.frame()
modelo_lda <- lda(cluster~., data=masterip_g11_final)
n <- ncol(masterip_g11_final)
predicciones <- predict(object = modelo_lda, newdata=masterip_g11_final[,-n])
#table(masterip_g11_final$cluster, predicciones$class, dnn=c("Clase real", "Clase predicha"))
training_error <- mean(masterip_g11_final$cluster != predicciones$class)*100
paste("Error de classification=", training_error, "%")
# Análisis de correlación
# Visualización de las soluciones usando ACP
library(factoextra)
fviz_cluster(km,data=masterip_g11_final,ellipse.type = "convex") +
theme_classic()
corrplot(cor(masterip_g11), order = "hclust", tl.col='black', tl.cex=1) #Gráfico de las correlaciones
masterip_g11_final <- masterip_g11 %>% mutate(cluster=km$cluster )
masterip_g1$cluster <- masterip_g11_final$cluster
masterip_g1 %>% tab_cols(total(),cluster) %>% tab_cells('Sede'=sede_cod) %>% tab_stat_cpct(total_row_position = "above")%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
tab_stat_median()%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
tab_stat_max()%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
tab_stat_min() %>%tab_cells('Sexo'=data_Tsexo,'Rango de edades'=data_T_RangoEdad,'Grado de Instruccion'=data_GRADO2,'Estado Civil'=data_Testado_civil,'Tenencia de Hijos'=data_T_numero_hijos,'Cantidad de Campañas'=data_veces) %>% tab_stat_cpct(total_row_position = "above") %>%
tab_cells('Edad'=data_Tedad,'Numero de hijos'=data_numero_hijos,'Porcentaje de Pobreza'=data_pobreza,'Dias en la Empresa'=data_dias_empresa, 'Distancia que recorre en metros'=data_distancia) %>%
tab_stat_mean() %>%
tab_cells('Otros Bonos'=data_otros_bono,'Numero de Lotes'=data_n_lote,'Numero de fundos'=data_n_fundo,'Numero de variedad'=data_n_variedad) %>%
tab_stat_median() %>%
tab_cells('Importe unico'=data_import_unico,'Importe Horas extra'=data_sum_hora_extra,'Bono total'=data_sum_aux_bono_total,
'Bono Produccion'=data_bono_produc,'Otros bonos'=data_otros_bono) %>%
tab_stat_mean() %>%
tab_cells('Bancarizado'=data_BANCARIZADO) %>%
tab_stat_mean() %>%
tab_cells('Peor calificación'=data_PEOR_CALIF_U6M,'Moda de Calificación'=data_MODA_CALIF_U6M,data_TIPCRE_UM) %>%
tab_stat_cpct(total_row_position = "above") %>%
tab_cells('Deuda Promedio'=data_DEUDA_PROM_U6M,'Promedio de Dias de atraso'=data_NRO_ENT_PROM_U6M,'Promedio de Dias de atraso'=data_DIAS_ATRASO_PROM_U6M) %>%
tab_stat_mean() %>%
tab_pivot() %>%
set_caption("Tabla describe cluster")
masterip_g1 %>% mutate(clus_camp=paste(cluster,'-',data_Tcamp)) %>% tab_cols(total(),clus_camp) %>% tab_cells('Importe unico'=data_import_unico,'Importe Horas extra'=data_sum_hora_extra,'Bono total'=data_sum_aux_bono_total,
'Bono Produccion'=data_bono_produc,'Otros bonos'=data_otros_bono) %>%
tab_stat_mean() %>%
tab_pivot() %>%
set_caption("Tabla describe cluster")
write.csv(masterip_g1,'cosecha_base_clus_4clusteres.csv',row.names=FALSE)
| Tabla describe cluster | ||||||||
| #Total | cluster | |||||||
|---|---|---|---|---|---|---|---|---|
| 1 | 2 | 3 | 4 | |||||
| Sede | #Total cases | 22079 | 3005 | 6019 | 12512 | 543 | ||
| Ica | 60.9 | 73.1 | 57.6 | 59.1 | 70.9 | |||
| Piura | 39.1 | 26.9 | 42.4 | 40.9 | 29.1 | |||
| Productividad | Median | 2.7 | 3.3 | 2.9 | 2.3 | 2.9 | ||
| Producción | Median | 276.0 | 1235.0 | 595.0 | 78.0 | 74.0 | ||
| Horas Laboraras | Median | 101.0 | 364.5 | 203.5 | 34.5 | 26.0 | ||
| Productividad | Max. | 331.1 | 12.5 | 134.1 | 331.1 | 85.5 | ||
| Producción | Max. | 5657.0 | 4697.0 | 3246.0 | 5657.0 | 3104.0 | ||
| Horas Laboraras | Max. | 711.8 | 711.8 | 624.5 | 626.2 | 641.5 | ||
| Productividad | Min. | 0.2 | 0.9 | 0.4 | 0.2 | 0.2 | ||
| Producción | Min. | 1.0 | 5.0 | 3.0 | 1.0 | 1.0 | ||
| Horas Laboraras | Min. | 0.5 | 4.0 | 5.0 | 0.5 | 1.0 | ||
| Sexo | #Total cases | 22079 | 3005 | 6019 | 12512 | 543 | ||
| Hombre | 35.5 | 13.5 | 25.0 | 44.9 | 59.7 | |||
| Mujer | 64.5 | 86.5 | 75.0 | 55.1 | 40.3 | |||
| Rango de edades | #Total cases | 22079 | 3005 | 6019 | 12512 | 543 | ||
| DE 31 A 50 | 43.3 | 55.1 | 46.9 | 37.5 | 71.6 | |||
| MAS DE 50 | 6.2 | 8.7 | 6.0 | 5.2 | 18.6 | |||
| MENOR A 30 | 50.5 | 36.3 | 47.1 | 57.3 | 9.8 | |||
| Grado de Instruccion | #Total cases | 17560 | 2674 | 4976 | 9367 | 543 | ||
| ILETRADO | 2.7 | 3.0 | 3.1 | 2.4 | 2.0 | |||
| PRIMARIA COMPLETA | 13.8 | 15.3 | 14.6 | 12.7 | 17.9 | |||
| PRIMARIA INCOMPLETA | 8.5 | 7.8 | 8.8 | 8.6 | 6.8 | |||
| SECUNDARIA COMPLETA | 42.3 | 45.0 | 41.5 | 41.4 | 51.0 | |||
| SECUNDARIA IMCOMPLETA | 30.7 | 26.7 | 30.1 | 33.1 | 16.0 | |||
| SUPERIOR - TECNICO | 2.1 | 2.2 | 1.9 | 1.8 | 6.3 | |||
| Estado Civil | #Total cases | 22079 | 3005 | 6019 | 12512 | 543 | ||
| Casado(a)/conviviente/unionlibre | 8.0 | 9.2 | 8.4 | 7.0 | 20.3 | |||
| Divorciado(a)/separado(a) | 0.1 | 0.2 | 0.1 | 0.1 | ||||
| Soltero(a) | 91.8 | 90.4 | 91.4 | 92.9 | 79.7 | |||
| Viudo(a) | 0.1 | 0.2 | 0.1 | 0.1 | ||||
| Tenencia de Hijos | #Total cases | 22079 | 3005 | 6019 | 12512 | 543 | ||
| con hijos | 55.3 | 73.9 | 65.2 | 47.1 | 32.4 | |||
| sin hijos | 44.7 | 26.1 | 34.8 | 52.9 | 67.6 | |||
| Cantidad de Campañas | #Total cases | 22079 | 3005 | 6019 | 12512 | 543 | ||
| 1 | 52.8 | 23.0 | 46.8 | 64.5 | 16.2 | |||
| 2 | 21.3 | 23.6 | 22.6 | 20.2 | 20.6 | |||
| 3 | 11.9 | 19.8 | 14.0 | 8.6 | 21.4 | |||
| 4 | 8.2 | 16.8 | 9.6 | 4.9 | 20.4 | |||
| 5 | 5.7 | 16.7 | 7.0 | 1.8 | 21.4 | |||
| Edad | Mean | 32.2 | 35.1 | 32.8 | 30.7 | 41.5 | ||
| Numero de hijos | Mean | 0.8 | 1.1 | 0.9 | 0.6 | 0.5 | ||
| Porcentaje de Pobreza | Mean | 33.6 | 33.9 | 33.6 | 33.4 | 35.2 | ||
| Dias en la Empresa | Mean | 224.6 | 178.8 | 144.0 | 157.3 | 2922.4 | ||
| Distancia que recorre en metros | Mean | 93542.7 | 57677.6 | 84345.1 | 113179.3 | 20390.5 | ||
| Otros Bonos | Median | 3.5 | 109.8 | 41.4 | 0.0 | 16.0 | ||
| Numero de Lotes | Median | 5.0 | 14.0 | 9.0 | 2.0 | 2.0 | ||
| Numero de fundos | Median | 2.0 | 4.0 | 3.0 | 1.0 | 2.0 | ||
| Numero de variedad | Median | 2.0 | 4.0 | 3.0 | 1.0 | 2.0 | ||
| Importe unico | Mean | 623.9 | 1862.6 | 908.1 | 196.9 | 460.8 | ||
| Importe Horas extra | Mean | 18.4 | 63.0 | 24.1 | 4.4 | 30.1 | ||
| Bono total | Mean | 178.6 | 625.6 | 239.0 | 42.4 | 172.6 | ||
| Bono Produccion | Mean | 126.5 | 489.9 | 158.5 | 23.8 | 129.9 | ||
| Otros bonos | Mean | 55.3 | 150.6 | 83.5 | 19.2 | 47.1 | ||
| Bancarizado | Mean | 0.7 | 0.7 | 0.7 | 0.7 | 0.9 | ||
| Peor calificación | #Total cases | 22074 | 3005 | 6019 | 12507 | 543 | ||
| 0.NORMAL | 19.2 | 20.6 | 18.6 | 18.2 | 42.9 | |||
| 1.CPP | 3.7 | 4.1 | 4.2 | 3.3 | 5.0 | |||
| 2.DEFICIENTE | 1.6 | 1.8 | 1.3 | 1.6 | 2.0 | |||
| 3.DUDOSO | 2.3 | 2.9 | 2.2 | 2.2 | 2.9 | |||
| 4.EN PERDIDA | 21.7 | 18.0 | 22.6 | 22.5 | 17.3 | |||
| 8.SIN CALIFICACION | 51.5 | 52.7 | 51.1 | 52.3 | 29.8 | |||
| Moda de Calificación | #Total cases | 10648 | 1411 | 2924 | 5939 | 374 | ||
| 0.NORMAL | 53.1 | 60.0 | 52.3 | 50.6 | 72.7 | |||
| 1.CPP | 2.1 | 1.7 | 2.2 | 2.1 | 1.6 | |||
| 2.DEFICIENTE | 1.0 | 1.3 | 1.0 | 0.9 | 1.1 | |||
| 3.DUDOSO | 2.8 | 2.8 | 2.8 | 2.7 | 2.1 | |||
| 4.EN PERDIDA | 41.1 | 34.2 | 41.7 | 43.6 | 22.5 | |||
| data_TIPCRE_UM | #Total cases | 7461 | 1057 | 2035 | 4051 | 318 | ||
| CONSUMO NO REVOLVENTE | 48.3 | 52.8 | 44.3 | 47.0 | 75.2 | |||
| CONSUMO REVOLVENTE | 10.6 | 10.9 | 9.9 | 10.8 | 11.9 | |||
| HIPOTECARIOS PARA VIVIENDA | 0.5 | 0.5 | 0.5 | 0.5 | 0.9 | |||
| MICROEMPRESAS | 39.0 | 34.3 | 43.5 | 40.1 | 11.6 | |||
| PEQUENAS EMPRESAS | 1.6 | 1.5 | 1.8 | 1.6 | 0.3 | |||
| Deuda Promedio | Mean | 4094.9 | 4439.6 | 3868.8 | 3832.9 | 8020.4 | ||
| Promedio de Dias de atraso | Mean | 1.5 | 1.5 | 1.5 | 1.5 | 1.6 | ||
| 66.7 | 65.2 | 70.5 | 65.5 | 62.6 | ||||
| Tabla describe cluster | ||||||||||||||||
| #Total | clus_camp | |||||||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 - 18 | 1 - 19 | 1 - 20 | 2 - 18 | 2 - 19 | 2 - 20 | 3 - 18 | 3 - 19 | 3 - 20 | 4 - 18 | 4 - 19 | 4 - 20 | |||||
| Importe unico | Mean | 623.9 | 1449.4 | 1963.2 | 1786.0 | 990.0 | 920.6 | 855.0 | 155.5 | 191.3 | 220.2 | 471.2 | 467.3 | 442.9 | ||
| Importe Horas extra | Mean | 18.4 | 101.0 | 60.8 | 57.1 | 50.1 | 18.3 | 19.0 | 6.6 | 4.8 | 3.1 | 36.1 | 29.3 | 27.1 | ||
| Bono total | Mean | 178.6 | 219.7 | 368.3 | 1202.5 | 130.8 | 161.9 | 381.6 | 17.8 | 30.0 | 67.2 | 113.9 | 139.5 | 268.9 | ||
| Bono Produccion | Mean | 126.5 | 161.9 | 297.3 | 927.9 | 115.8 | 133.3 | 208.5 | 16.0 | 26.8 | 23.3 | 92.7 | 118.3 | 176.2 | ||
| Otros bonos | Mean | 55.3 | 57.9 | 78.6 | 306.5 | 15.0 | 30.3 | 179.0 | 1.8 | 3.6 | 44.8 | 21.2 | 24.9 | 101.6 | ||
# Para 5 Clusteres
set.seed(1234)
km <- kmeans(masterip_g11, 5, iter.max = 1000, nstart=10)
paste("SS between cluster=", (km$betweens/km$totss) *100, "%")
# Para la validación de los cluster usamos Análisis discriminante
scores_cluster <- km$cluster %>% as.data.frame()
colnames(scores_cluster) <- c("cluster")
masterip_g11_final <- cbind(masterip_g11,scores_cluster) %>% as.data.frame()
modelo_lda <- lda(cluster~., data=masterip_g11_final)
n <- ncol(masterip_g11_final)
predicciones <- predict(object = modelo_lda, newdata=masterip_g11_final[,-n])
#table(masterip_g11_final$cluster, predicciones$class, dnn=c("Clase real", "Clase predicha"))
training_error <- mean(masterip_g11_final$cluster != predicciones$class)*100
paste("Error de classification=", training_error, "%")
# Análisis de correlación
# Visualización de las soluciones usando ACP
library(factoextra)
fviz_cluster(km,data=masterip_g11_final,ellipse.type = "convex") +
theme_classic()
corrplot(cor(masterip_g11), order = "hclust", tl.col='black', tl.cex=1) #Gráfico de las correlaciones
masterip_g11_final <- masterip_g11 %>% mutate(cluster=km$cluster )
masterip_g1$cluster <- masterip_g11_final$cluster
masterip_g1 %>% tab_cols(total(),cluster) %>% tab_cells('Sede'=sede_cod) %>% tab_stat_cpct(total_row_position = "above")%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
tab_stat_median()%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
tab_stat_max()%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
tab_stat_min() %>%tab_cells('Sexo'=data_Tsexo,'Rango de edades'=data_T_RangoEdad,'Grado de Instruccion'=data_GRADO2,'Estado Civil'=data_Testado_civil,'Tenencia de Hijos'=data_T_numero_hijos,'Cantidad de Campañas'=data_veces) %>% tab_stat_cpct(total_row_position = "above") %>%
tab_cells('Edad'=data_Tedad,'Numero de hijos'=data_numero_hijos,'Porcentaje de Pobreza'=data_pobreza,'Dias en la Empresa'=data_dias_empresa, 'Distancia que recorre en metros'=data_distancia) %>%
tab_stat_mean() %>%
tab_cells('Otros Bonos'=data_otros_bono,'Numero de Lotes'=data_n_lote,'Numero de fundos'=data_n_fundo,'Numero de variedad'=data_n_variedad) %>%
tab_stat_median() %>%
tab_cells('Importe unico'=data_import_unico,'Importe Horas extra'=data_sum_hora_extra,'Bono total'=data_sum_aux_bono_total,
'Bono Produccion'=data_bono_produc,'Otros bonos'=data_otros_bono) %>%
tab_stat_mean() %>%
tab_cells('Bancarizado'=data_BANCARIZADO) %>%
tab_stat_mean() %>%
tab_cells('Peor calificación'=data_PEOR_CALIF_U6M,'Moda de Calificación'=data_MODA_CALIF_U6M,data_TIPCRE_UM) %>%
tab_stat_cpct(total_row_position = "above") %>%
tab_cells('Deuda Promedio'=data_DEUDA_PROM_U6M,'Promedio de Dias de atraso'=data_NRO_ENT_PROM_U6M,'Promedio de Dias de atraso'=data_DIAS_ATRASO_PROM_U6M) %>%
tab_stat_mean() %>%
tab_pivot() %>%
set_caption("Tabla describe cluster")
masterip_g1 %>% mutate(clus_camp=paste(cluster,'-',data_Tcamp)) %>% tab_cols(total(),clus_camp) %>% tab_cells('Importe unico'=data_import_unico,'Importe Horas extra'=data_sum_hora_extra,'Bono total'=data_sum_aux_bono_total,
'Bono Produccion'=data_bono_produc,'Otros bonos'=data_otros_bono) %>%
tab_stat_mean() %>%
tab_pivot() %>%
set_caption("Tabla describe cluster")
write.csv(masterip_g1,'cosecha_base_clus_5clusteres.csv',row.names=FALSE)
| Tabla describe cluster | |||||||||
| #Total | cluster | ||||||||
|---|---|---|---|---|---|---|---|---|---|
| 1 | 2 | 3 | 4 | 5 | |||||
| Sede | #Total cases | 22079 | 5931 | 12396 | 249 | 2973 | 530 | ||
| Ica | 60.9 | 57.8 | 59.0 | 70.3 | 73.0 | 67.7 | |||
| Piura | 39.1 | 42.2 | 41.0 | 29.7 | 27.0 | 32.3 | |||
| Productividad | Median | 2.7 | 2.9 | 2.3 | 2.9 | 3.3 | 2.9 | ||
| Producción | Median | 276.0 | 601.0 | 81.0 | 88.0 | 1235.0 | 60.5 | ||
| Horas Laboraras | Median | 101.0 | 205.8 | 35.5 | 27.5 | 365.0 | 22.0 | ||
| Productividad | Max. | 331.1 | 134.1 | 331.1 | 10.0 | 12.5 | 85.5 | ||
| Producción | Max. | 5657.0 | 3246.0 | 5657.0 | 3104.0 | 4697.0 | 3072.0 | ||
| Horas Laboraras | Max. | 711.8 | 624.5 | 626.2 | 641.5 | 711.8 | 596.0 | ||
| Productividad | Min. | 0.2 | 0.4 | 0.2 | 0.5 | 0.9 | 0.2 | ||
| Producción | Min. | 1.0 | 3.0 | 1.0 | 1.0 | 5.0 | 2.0 | ||
| Horas Laboraras | Min. | 0.5 | 5.0 | 0.5 | 1.0 | 4.0 | 1.0 | ||
| Sexo | #Total cases | 22079 | 5931 | 12396 | 249 | 2973 | 530 | ||
| Hombre | 35.5 | 24.9 | 44.9 | 67.1 | 13.5 | 45.1 | |||
| Mujer | 64.5 | 75.1 | 55.1 | 32.9 | 86.5 | 54.9 | |||
| Rango de edades | #Total cases | 22079 | 5931 | 12396 | 249 | 2973 | 530 | ||
| DE 31 A 50 | 43.3 | 47.0 | 37.1 | 69.1 | 55.1 | 68.7 | |||
| MAS DE 50 | 6.2 | 6.0 | 5.2 | 26.5 | 8.7 | 8.5 | |||
| MENOR A 30 | 50.5 | 47.0 | 57.7 | 4.4 | 36.3 | 22.8 | |||
| Grado de Instruccion | #Total cases | 17560 | 4905 | 9238 | 249 | 2645 | 523 | ||
| ILETRADO | 2.7 | 3.1 | 2.4 | 3.2 | 3.1 | 1.1 | |||
| PRIMARIA COMPLETA | 13.8 | 14.6 | 12.7 | 19.3 | 15.4 | 14.5 | |||
| PRIMARIA INCOMPLETA | 8.5 | 8.8 | 8.7 | 7.2 | 7.8 | 5.4 | |||
| SECUNDARIA COMPLETA | 42.3 | 41.5 | 41.4 | 53.0 | 44.8 | 48.0 | |||
| SECUNDARIA IMCOMPLETA | 30.7 | 30.0 | 33.1 | 11.2 | 26.7 | 26.2 | |||
| SUPERIOR - TECNICO | 2.1 | 1.9 | 1.8 | 6.0 | 2.3 | 4.8 | |||
| Estado Civil | #Total cases | 22079 | 5931 | 12396 | 249 | 2973 | 530 | ||
| Casado(a)/conviviente/unionlibre | 8.0 | 8.4 | 6.8 | 28.1 | 9.2 | 14.9 | |||
| Divorciado(a)/separado(a) | 0.1 | 0.1 | 0.1 | 0.2 | |||||
| Soltero(a) | 91.8 | 91.4 | 93.0 | 71.9 | 90.4 | 85.1 | |||
| Viudo(a) | 0.1 | 0.1 | 0.1 | 0.2 | |||||
| Tenencia de Hijos | #Total cases | 22079 | 5931 | 12396 | 249 | 2973 | 530 | ||
| con hijos | 55.3 | 65.5 | 47.3 | 24.9 | 73.9 | 37.9 | |||
| sin hijos | 44.7 | 34.5 | 52.7 | 75.1 | 26.1 | 62.1 | |||
| Cantidad de Campañas | #Total cases | 22079 | 5931 | 12396 | 249 | 2973 | 530 | ||
| 1 | 52.8 | 46.7 | 65.2 | 21.7 | 23.2 | 12.6 | |||
| 2 | 21.3 | 22.7 | 20.3 | 21.3 | 23.6 | 17.5 | |||
| 3 | 11.9 | 14.2 | 8.2 | 19.7 | 19.7 | 26.4 | |||
| 4 | 8.2 | 9.5 | 4.6 | 17.7 | 16.8 | 26.0 | |||
| 5 | 5.7 | 7.0 | 1.7 | 19.7 | 16.7 | 17.4 | |||
| Edad | Mean | 32.2 | 32.9 | 30.6 | 43.9 | 35.1 | 37.4 | ||
| Numero de hijos | Mean | 0.8 | 0.9 | 0.6 | 0.4 | 1.1 | 0.6 | ||
| Porcentaje de Pobreza | Mean | 33.6 | 33.6 | 33.4 | 33.4 | 33.9 | 36.2 | ||
| Dias en la Empresa | Mean | 224.6 | 138.7 | 139.8 | 3839.2 | 176.8 | 1737.2 | ||
| Distancia que recorre en metros | Mean | 93542.7 | 83849.8 | 114424.4 | 11595.9 | 57905.3 | 40458.9 | ||
| Otros Bonos | Median | 3.5 | 41.4 | 0.0 | 15.8 | 109.8 | 12.8 | ||
| Numero de Lotes | Median | 5.0 | 9.0 | 3.0 | 2.0 | 14.0 | 2.0 | ||
| Numero de fundos | Median | 2.0 | 3.0 | 1.0 | 2.0 | 4.0 | 2.0 | ||
| Numero de variedad | Median | 2.0 | 3.0 | 1.0 | 1.0 | 4.0 | 1.5 | ||
| Importe unico | Mean | 623.9 | 915.6 | 200.1 | 494.7 | 1867.5 | 359.5 | ||
| Importe Horas extra | Mean | 18.4 | 24.3 | 4.3 | 33.8 | 63.1 | 23.2 | ||
| Bono total | Mean | 178.6 | 240.7 | 43.1 | 190.3 | 627.0 | 131.2 | ||
| Bono Produccion | Mean | 126.5 | 159.9 | 24.2 | 144.0 | 490.9 | 95.1 | ||
| Otros bonos | Mean | 55.3 | 83.8 | 19.4 | 51.7 | 151.1 | 39.1 | ||
| Bancarizado | Mean | 0.7 | 0.7 | 0.7 | 0.9 | 0.7 | 0.9 | ||
| Peor calificación | #Total cases | 22074 | 5931 | 12391 | 249 | 2973 | 530 | ||
| 0.NORMAL | 19.2 | 18.4 | 18.0 | 45.4 | 20.5 | 37.2 | |||
| 1.CPP | 3.7 | 4.3 | 3.3 | 5.2 | 4.1 | 4.0 | |||
| 2.DEFICIENTE | 1.6 | 1.3 | 1.6 | 1.6 | 1.8 | 2.5 | |||
| 3.DUDOSO | 2.3 | 2.2 | 2.2 | 4.0 | 2.9 | 1.9 | |||
| 4.EN PERDIDA | 21.7 | 22.6 | 22.4 | 17.3 | 17.9 | 20.0 | |||
| 8.SIN CALIFICACION | 51.5 | 51.2 | 52.6 | 26.5 | 52.9 | 34.5 | |||
| Moda de Calificación | #Total cases | 10648 | 2878 | 5856 | 181 | 1392 | 341 | ||
| 0.NORMAL | 53.1 | 52.0 | 50.3 | 73.5 | 60.1 | 70.1 | |||
| 1.CPP | 2.1 | 2.2 | 2.1 | 1.1 | 1.7 | 2.3 | |||
| 2.DEFICIENTE | 1.0 | 1.0 | 0.9 | 1.1 | 1.3 | 1.2 | |||
| 3.DUDOSO | 2.8 | 2.9 | 2.8 | 2.2 | 2.8 | 1.2 | |||
| 4.EN PERDIDA | 41.1 | 41.9 | 43.8 | 22.1 | 34.1 | 25.2 | |||
| data_TIPCRE_UM | #Total cases | 7461 | 1999 | 3981 | 155 | 1045 | 281 | ||
| CONSUMO NO REVOLVENTE | 48.3 | 44.3 | 46.4 | 80.0 | 52.4 | 70.8 | |||
| CONSUMO REVOLVENTE | 10.6 | 9.7 | 10.7 | 11.6 | 11.0 | 14.2 | |||
| HIPOTECARIOS PARA VIVIENDA | 0.5 | 0.6 | 0.5 | 0.5 | 1.1 | ||||
| MICROEMPRESAS | 39.0 | 43.6 | 40.9 | 8.4 | 34.5 | 12.8 | |||
| PEQUENAS EMPRESAS | 1.6 | 1.8 | 1.6 | 1.5 | 1.1 | ||||
| Deuda Promedio | Mean | 4094.9 | 3865.6 | 3783.3 | 8211.8 | 4463.4 | 6859.2 | ||
| Promedio de Dias de atraso | Mean | 1.5 | 1.5 | 1.5 | 1.5 | 1.5 | 1.7 | ||
| 66.7 | 70.8 | 66.6 | 24.6 | 65.1 | 66.5 | ||||
| Tabla describe cluster | |||||||||||||||||||
| #Total | clus_camp | ||||||||||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 - 18 | 1 - 19 | 1 - 20 | 2 - 18 | 2 - 19 | 2 - 20 | 3 - 18 | 3 - 19 | 3 - 20 | 4 - 18 | 4 - 19 | 4 - 20 | 5 - 18 | 5 - 19 | 5 - 20 | |||||
| Importe unico | Mean | 623.9 | 1001.2 | 927.8 | 860.7 | 159.6 | 194.2 | 223.2 | 506.8 | 479.5 | 510.5 | 1452.7 | 1966.7 | 1788.7 | 351.0 | 363.6 | 359.7 | ||
| Importe Horas extra | Mean | 18.4 | 50.5 | 18.4 | 19.2 | 6.7 | 4.6 | 3.0 | 37.6 | 35.7 | 28.4 | 102.8 | 61.0 | 57.2 | 27.7 | 20.6 | 23.6 | ||
| Bono total | Mean | 178.6 | 131.8 | 164.0 | 383.7 | 18.0 | 30.2 | 68.3 | 110.3 | 143.7 | 316.5 | 220.4 | 368.8 | 1202.2 | 87.7 | 92.8 | 236.6 | ||
| Bono Produccion | Mean | 126.5 | 116.3 | 135.0 | 210.1 | 16.5 | 27.2 | 23.7 | 88.6 | 119.3 | 219.5 | 162.3 | 297.7 | 927.1 | 70.5 | 74.2 | 153.3 | ||
| Otros bonos | Mean | 55.3 | 15.6 | 30.6 | 179.7 | 1.6 | 3.5 | 45.5 | 21.7 | 28.3 | 108.2 | 58.3 | 78.8 | 306.8 | 17.2 | 20.9 | 90.3 | ||
library(rpart)
library(rpart.plot)
library(caret)
library(partykit)
Loading required package: lattice
Attaching package: ‘caret’
The following object is masked from ‘package:purrr’:
lift
Loading required package: grid
Loading required package: libcoin
Loading required package: mvtnorm
masterip_g1<-masterip_g1 %>% mutate(q1 = ntile(data_productividad_per,3)) %>% mutate(productividad_cat=case_when(q1=='1'~'BAJO',q1=='2'~'MEDIO',q1=='3'~'ALTO',TRUE ~ 'OTRO')) %>% dplyr::select(-q1)
masterip_g14<-masterip_g1%>% dplyr::select(
data_GRADO2,
data_sum_variedad_total_AL,
data_sum_variedad_total_CC,
data_sum_variedad_total_CP,
data_sum_variedad_total_JS,
data_sum_variedad_total_MG,
data_sum_variedad_total_RG,
data_sum_variedad_total_SG,
data_sum_variedad_total_TC,
data_sum_variedad_total_TM,
data_sum_variedad_total_VN,
data_sum_aux_bono_total,
data_sum_hora_extra,
data_n_lote,
data_n_fundo,
data_Testado_civil,
data_Tsexo,
data_dias_empresa,
data_Tedad,
data_numero_hijos,
data_pobreza,
data_n_variedad,
data_veces,
data_DEUDA_PROM_U6M,
data_PEOR_CALIF_U6M,
data_MODA_CALIF_U6M,
data_NRO_ENT_PROM_U6M,
data_TIPCRE_UM,
data_DIAS_ATRASO_PROM_U6M,
data_BANCARIZADO,
data_distancia,
data_import_unico,
data_bono_produc,
data_otros_bono,
dummies_Tsexo_Mujer,sede_cod,data_numero_asistentes,
data_asistente_mediana_Tedad,
data_asistente_mediana_numero_hijos,
data_asistente_dias_empresa,cluster,productividad_cat)
####################################################
# ÁRBOL DE CLASIFICACIÓN CON EL ALGORITMO CART #
####################################################
set.seed(123)
arbol_1 <- rpart(factor(productividad_cat)~.,
data=masterip_g14,
method="class",
parms=list(split='gini'))
#Graficando el árbol
rpart.plot(arbol_1, digits=-1, type=0, extra=102,cex = .7, nn=TRUE)
rpart.plot(arbol_1, digits=-1, type=1, extra=106,cex = .7, nn=TRUE)
rpart.plot(arbol_1, digits=-1, type=2, extra=102,cex = .7, nn=TRUE)
rpart.plot(arbol_1, digits=-1, type=3, extra=105,cex = .7, nn=TRUE)
rpart.plot(arbol_1, digits=-1, type=4, extra=105,cex = .7, nn=TRUE)
#library(caret)
#varImp(arbol_1)
# Mejorando los Gráficos
plot(as.party(arbol_1), tp_args = list(id = FALSE))
####################################################
# CART CON CARET Y VALIDACIÓN CRUZADA REPETIDA #
####################################################
Warning message: “extra=106 but the response has 3 levels (only the 2nd level is displayed)”
####################################################
# CART CON CARET Y VALIDACIÓN CRUZADA REPETIDA #
####################################################
names(getModelInfo())
#Relación de parámetros a ajustar de un modelo
modelLookup(model='rpart')
# Aplicando el modelo con Validación Cruzada Repetida
ctrl <- trainControl(method="repeatedcv", repeats = 5, number=2)
df_dep1 <- na.omit(masterip_g14)
set.seed(123)
modelo_cart_1 <- train(factor(productividad_cat)~.,
data=masterip_g14,
method = "rpart",
trControl = ctrl,
tuneLength = 20,
metric="Accuracy")
modelo_cart_1
varImp(modelo_cart_1)
# BASE DE DATOS
#--------------
# SELECCIÓN DE VARIABLES
masteripr_g1 <- df1 %>% dplyr::select(data_productividad_per,data_Tcamp ,
data_sumCOD,
data_sumHRSLB,
data_GRADO2,
data_sum_variedad_total_AL,
data_sum_variedad_total_CC,
data_sum_variedad_total_CP,
data_sum_variedad_total_JS,
data_sum_variedad_total_MG,
data_sum_variedad_total_RG,
data_sum_variedad_total_SG,
data_sum_variedad_total_TC,
data_sum_variedad_total_TM,
data_sum_variedad_total_VN,
data_sum_aux_bono_total,
data_sum_hora_extra,
data_n_lote,
data_n_fundo,
data_T_RangoEdad,
data_Testado_civil,
data_Tsexo,
data_T_numero_hijos,
data_dias_empresa,
data_Tedad,
data_numero_hijos,
data_pobreza,
data_n_variedad,
data_veces,
data_DEUDA_PROM_U6M,
data_PEOR_CALIF_U6M,
data_MODA_CALIF_U6M,
data_NRO_ENT_PROM_U6M,
data_TIPCRE_UM,
data_DIAS_ATRASO_PROM_U6M,
data_BANCARIZADO,
data_distancia,
data_import_unico,
data_total,
data_bono_produc,
data_otros_bono,
dummies_Tsexo_Mujer,sede_cod,data_numero_asistentes,
data_asistente_mediana_Tedad,
data_asistente_mediana_numero_hijos,
data_asistente_dias_empresa)
###############################################################################################
###################################### ANALISIS CLUSTER #######################################
###############################################################################################
masteripr_g11 <- masteripr_g1 %>% dplyr::select(data_productividad_per,
data_bono_produc,
data_otros_bono,
data_import_unico,
data_dias_empresa,
data_Tedad,
data_numero_hijos,
data_pobreza,
data_veces,
dummies_Tsexo_Mujer,
data_numero_asistentes,
data_asistente_mediana_Tedad,
data_asistente_mediana_numero_hijos,
data_asistente_dias_empresa
)
masteripr_g11 <- na.omit(masteripr_g11)
masteripr_g11 <- masteripr_g1 %>% dplyr::select(data_productividad_per,
data_import_unico,
data_dias_empresa,
data_Tedad,
data_numero_hijos,
data_pobreza,
data_veces,
dummies_Tsexo_Mujer)
#######################################
# Cluster de Partición - No Jerárquicos
########################################
# Usando el criterio del Gráfico de Silueta
set.seed(123)
a<-fviz_nbclust(masteripr_g11, FUNcluster = kmeans, method = "silhouette", k.max = 20) +
labs(subtitle = "Silhouette method")
a
b<-a$data%>%slice(which.max(y))
b<-as.numeric(b[1,1])
paste("Numero de cluster=", b)
k <- b
set.seed(1234)
km <- kmeans(masteripr_g11, k, iter.max = 1000, nstart=10)
paste("SS between cluster=", (km$betweens/km$totss) *100, "%")
# Para la validación de los cluster usamos Análisis discriminante
scores_cluster <- km$cluster %>% as.data.frame()
colnames(scores_cluster) <- c("cluster")
masteripr_g11_final <- cbind(masteripr_g11,scores_cluster) %>% as.data.frame()
modelo_lda <- lda(cluster~., data=masteripr_g11_final)
n <- ncol(masteripr_g11_final)
predicciones <- predict(object = modelo_lda, newdata=masteripr_g11_final[,-n])
#table(masteripr_g11_final$cluster, predicciones$class, dnn=c("Clase real", "Clase predicha"))
training_error <- mean(masteripr_g11_final$cluster != predicciones$class)*100
paste("Error de classification=", training_error, "%")
# Análisis de correlación
# Visualización de las soluciones usando ACP
library(factoextra)
fviz_cluster(km,data=masteripr_g11_final,ellipse.type = "convex") +
theme_classic()
corrplot(cor(masteripr_g11), order = "hclust", tl.col='black', tl.cex=1) #Gráfico de las correlaciones
masteripr_g11_final <- masteripr_g11 %>% mutate(cluster=km$cluster )
masteripr_g1$cluster <- masteripr_g11_final$cluster
masteripr_g1 %>% tab_cols(total(),cluster) %>% tab_cells('Sede'=sede_cod) %>% tab_stat_cpct(total_row_position = "above")%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
tab_stat_median()%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
tab_stat_max()%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
tab_stat_min() %>%tab_cells('Sexo'=data_Tsexo,'Rango de edades'=data_T_RangoEdad,'Grado de Instruccion'=data_GRADO2,'Estado Civil'=data_Testado_civil,'Tenencia de Hijos'=data_T_numero_hijos,'Cantidad de Campañas'=data_veces) %>% tab_stat_cpct(total_row_position = "above") %>%
tab_cells('Edad'=data_Tedad,'Numero de hijos'=data_numero_hijos,'Porcentaje de Pobreza'=data_pobreza,'Dias en la Empresa'=data_dias_empresa, 'Distancia que recorre en metros'=data_distancia) %>%
tab_stat_mean() %>%
tab_cells('Otros Bonos'=data_otros_bono,'Numero de Lotes'=data_n_lote,'Numero de fundos'=data_n_fundo,'Numero de variedad'=data_n_variedad) %>%
tab_stat_median() %>%
tab_cells('Importe unico'=data_import_unico,'Importe Horas extra'=data_sum_hora_extra,'Bono total'=data_sum_aux_bono_total,
'Bono Produccion'=data_bono_produc,'Otros bonos'=data_otros_bono) %>%
tab_stat_mean() %>%
tab_cells('Bancarizado'=data_BANCARIZADO) %>%
tab_stat_mean() %>%
tab_cells('Peor calificación'=data_PEOR_CALIF_U6M,'Moda de Calificación'=data_MODA_CALIF_U6M,data_TIPCRE_UM) %>%
tab_stat_cpct(total_row_position = "above") %>%
tab_cells('Deuda Promedio'=data_DEUDA_PROM_U6M,'Promedio de Dias de atraso'=data_NRO_ENT_PROM_U6M,'Promedio de Dias de atraso'=data_DIAS_ATRASO_PROM_U6M) %>%
tab_stat_mean() %>%
tab_pivot() %>%
set_caption("Tabla describe cluster")
masteripr_g1 %>% mutate(clus_camp=paste(cluster,'-',data_Tcamp)) %>% tab_cols(total(),clus_camp) %>% tab_cells('Importe unico'=data_import_unico,'Importe Horas extra'=data_sum_hora_extra,'Bono total'=data_sum_aux_bono_total,
'Bono Produccion'=data_bono_produc,'Otros bonos'=data_otros_bono) %>%
tab_stat_mean() %>%
tab_pivot() %>%
set_caption("Tabla describe cluster")
Warning message: “Quick-TRANSfer stage steps exceeded maximum (= 1155750)” Warning message: “did not converge in 10 iterations”
| Tabla describe cluster | |||||||
| #Total | cluster | ||||||
|---|---|---|---|---|---|---|---|
| 1 | 2 | 3 | |||||
| Sede | #Total cases | 23115 | 573 | 16459 | 6083 | ||
| Ica | 45.1 | 70.3 | 46.7 | 38.6 | |||
| Piura | 54.9 | 29.7 | 53.3 | 61.4 | |||
| Productividad | Median | 22.7 | 33.9 | 18.9 | 34.9 | ||
| Producción | Median | 788.0 | 815.0 | 380.0 | 10289.0 | ||
| Horas Laboraras | Median | 76.5 | 45.0 | 39.2 | 301.0 | ||
| Productividad | Max. | 238.5 | 149.3 | 238.5 | 224.1 | ||
| Producción | Max. | 96681.0 | 40975.0 | 46374.0 | 96681.0 | ||
| Horas Laboraras | Max. | 836.5 | 580.5 | 348.0 | 836.5 | ||
| Productividad | Min. | 0.1 | 0.4 | 0.1 | 0.3 | ||
| Producción | Min. | 1.0 | 3.0 | 1.0 | 4.0 | ||
| Horas Laboraras | Min. | 0.2 | 2.0 | 0.2 | 8.0 | ||
| Sexo | #Total cases | 23115 | 573 | 16459 | 6083 | ||
| Hombre | 46.2 | 58.3 | 47.5 | 41.6 | |||
| Mujer | 53.8 | 41.7 | 52.5 | 58.4 | |||
| Rango de edades | #Total cases | 23115 | 573 | 16459 | 6083 | ||
| DE 31 A 50 | 44.0 | 74.2 | 41.4 | 48.2 | |||
| MAS DE 50 | 4.7 | 13.6 | 4.5 | 4.3 | |||
| MENOR A 30 | 51.3 | 12.2 | 54.1 | 47.5 | |||
| Grado de Instruccion | #Total cases | 18840 | 573 | 13107 | 5160 | ||
| EDUCACION ESPECIAL | 0.0 | 0.0 | |||||
| ILETRADO | 2.5 | 1.9 | 2.2 | 3.2 | |||
| PRIMARIA COMPLETA | 14.4 | 17.1 | 13.3 | 17.0 | |||
| PRIMARIA INCOMPLETA | 9.7 | 6.1 | 8.7 | 12.5 | |||
| SECUNDARIA COMPLETA | 40.8 | 49.9 | 41.9 | 37.2 | |||
| SECUNDARIA IMCOMPLETA | 31.0 | 19.2 | 32.4 | 28.7 | |||
| SUPERIOR - TECNICO | 1.6 | 5.8 | 1.5 | 1.4 | |||
| Estado Civil | #Total cases | 23115 | 573 | 16459 | 6083 | ||
| Casado(a)/conviviente/unionlibre | 7.9 | 20.8 | 6.8 | 9.7 | |||
| Divorciado(a)/separado(a) | 0.1 | 0.1 | 0.1 | ||||
| Soltero(a) | 91.9 | 79.2 | 93.0 | 90.1 | |||
| Viudo(a) | 0.1 | 0.1 | 0.2 | ||||
| Tenencia de Hijos | #Total cases | 23115 | 573 | 16459 | 6083 | ||
| con hijos | 52.1 | 26.0 | 46.8 | 68.8 | |||
| sin hijos | 47.9 | 74.0 | 53.2 | 31.2 | |||
| Cantidad de Campañas | #Total cases | 23115 | 573 | 16459 | 6083 | ||
| 1 | 51.9 | 4.0 | 61.2 | 31.4 | |||
| 2 | 22.9 | 8.2 | 21.6 | 28.0 | |||
| 3 | 11.5 | 14.8 | 8.5 | 19.5 | |||
| 4 | 7.9 | 27.2 | 5.3 | 12.9 | |||
| 5 | 5.7 | 45.7 | 3.4 | 8.2 | |||
| Edad | Mean | 31.8 | 40.3 | 31.3 | 32.3 | ||
| Numero de hijos | Mean | 0.7 | 0.4 | 0.6 | 1.0 | ||
| Porcentaje de Pobreza | Mean | 32.8 | 34.8 | 32.8 | 32.7 | ||
| Dias en la Empresa | Mean | 257.5 | 2981.2 | 180.4 | 209.3 | ||
| Distancia que recorre en metros | Mean | 94220.0 | 18581.8 | 108558.9 | 66591.0 | ||
| Otros Bonos | Median | 0.0 | 1.3 | 0.0 | 0.0 | ||
| Numero de Lotes | Median | 4.0 | 3.0 | 2.0 | 12.0 | ||
| Numero de fundos | Median | 2.0 | 2.0 | 1.0 | 3.0 | ||
| Numero de variedad | Median | 2.0 | 1.0 | 1.0 | 3.0 | ||
| Importe unico | Mean | 545.1 | 402.0 | 249.0 | 1359.8 | ||
| Importe Horas extra | Mean | 9.8 | 28.3 | 6.1 | 18.1 | ||
| Bono total | Mean | 315.3 | 190.2 | 137.9 | 807.2 | ||
| Bono Produccion | Mean | 262.5 | 181.9 | 110.4 | 681.5 | ||
| Otros bonos | Mean | 1.4 | 18.0 | 1.1 | 0.8 | ||
| Bancarizado | Mean | 0.7 | 0.9 | 0.7 | 0.8 | ||
| Peor calificación | #Total cases | 23112 | 573 | 16456 | 6083 | ||
| 0.NORMAL | 21.0 | 46.4 | 19.6 | 22.3 | |||
| 1.CPP | 4.0 | 4.4 | 4.0 | 3.8 | |||
| 2.DEFICIENTE | 1.8 | 2.1 | 1.9 | 1.7 | |||
| 3.DUDOSO | 2.6 | 1.9 | 2.6 | 2.8 | |||
| 4.EN PERDIDA | 23.5 | 16.4 | 24.4 | 21.8 | |||
| 8.SIN CALIFICACION | 47.0 | 28.8 | 47.4 | 47.7 | |||
| Moda de Calificación | #Total cases | 12191 | 406 | 8612 | 3173 | ||
| 0.NORMAL | 52.7 | 75.6 | 50.1 | 56.8 | |||
| 1.CPP | 2.2 | 2.0 | 2.3 | 1.9 | |||
| 2.DEFICIENTE | 1.3 | 0.5 | 1.4 | 1.3 | |||
| 3.DUDOSO | 3.5 | 2.2 | 3.8 | 2.9 | |||
| 4.EN PERDIDA | 40.3 | 19.7 | 42.5 | 37.1 | |||
| data_TIPCRE_UM | #Total cases | 8528 | 347 | 5902 | 2279 | ||
| CONSUMO NO REVOLVENTE | 49.5 | 76.7 | 48.2 | 48.7 | |||
| CONSUMO REVOLVENTE | 10.8 | 14.1 | 10.9 | 10.0 | |||
| HIPOTECARIOS PARA VIVIENDA | 0.4 | 0.3 | 0.5 | 0.2 | |||
| MICROEMPRESAS | 37.8 | 8.4 | 38.8 | 39.8 | |||
| PEQUENAS EMPRESAS | 1.5 | 0.6 | 1.6 | 1.3 | |||
| Deuda Promedio | Mean | 4033.0 | 7702.3 | 3881.2 | 3887.8 | ||
| Promedio de Dias de atraso | Mean | 1.5 | 1.6 | 1.5 | 1.5 | ||
| 62.2 | 70.3 | 63.3 | 57.9 | ||||
| Tabla describe cluster | ||||||||||
| #Total | clus_camp | |||||||||
|---|---|---|---|---|---|---|---|---|---|---|
| 1 - 19 | 1 - 20 | 2 - 19 | 2 - 20 | 3 - 19 | 3 - 20 | |||||
| Importe unico | Mean | 545.1 | 446.2 | 349.9 | 265.5 | 233.3 | 1400.0 | 1306.1 | ||
| Importe Horas extra | Mean | 9.8 | 16.1 | 42.7 | 4.7 | 7.4 | 17.7 | 18.5 | ||
| Bono total | Mean | 315.3 | 181.3 | 200.6 | 135.2 | 140.5 | 752.8 | 880.0 | ||
| Bono Produccion | Mean | 262.5 | 159.6 | 208.1 | 91.8 | 128.0 | 647.6 | 726.9 | ||
| Otros bonos | Mean | 1.4 | 21.6 | 13.8 | 0.9 | 1.2 | 0.9 | 0.7 | ||
# CON 4 CLUSTERES
set.seed(1234)
km <- kmeans(masteripr_g11, 4, iter.max = 1000, nstart=10)
paste("SS between cluster=", (km$betweens/km$totss) *100, "%")
# Para la validación de los cluster usamos Análisis discriminante
scores_cluster <- km$cluster %>% as.data.frame()
colnames(scores_cluster) <- c("cluster")
masteripr_g11_final <- cbind(masteripr_g11,scores_cluster) %>% as.data.frame()
modelo_lda <- lda(cluster~., data=masteripr_g11_final)
n <- ncol(masteripr_g11_final)
predicciones <- predict(object = modelo_lda, newdata=masteripr_g11_final[,-n])
#table(masteripr_g11_final$cluster, predicciones$class, dnn=c("Clase real", "Clase predicha"))
training_error <- mean(masteripr_g11_final$cluster != predicciones$class)*100
paste("Error de classification=", training_error, "%")
# Análisis de correlación
# Visualización de las soluciones usando ACP
library(factoextra)
fviz_cluster(km,data=masteripr_g11_final,ellipse.type = "convex") +
theme_classic()
corrplot(cor(masteripr_g11), order = "hclust", tl.col='black', tl.cex=1) #Gráfico de las correlaciones
masteripr_g11_final <- masteripr_g11 %>% mutate(cluster=km$cluster )
masteripr_g1$cluster <- masteripr_g11_final$cluster
masteripr_g1 %>% tab_cols(total(),cluster) %>% tab_cells('Sede'=sede_cod) %>% tab_stat_cpct(total_row_position = "above")%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
tab_stat_median()%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
tab_stat_max()%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
tab_stat_min() %>%tab_cells('Sexo'=data_Tsexo,'Rango de edades'=data_T_RangoEdad,'Grado de Instruccion'=data_GRADO2,'Estado Civil'=data_Testado_civil,'Tenencia de Hijos'=data_T_numero_hijos,'Cantidad de Campañas'=data_veces) %>% tab_stat_cpct(total_row_position = "above") %>%
tab_cells('Edad'=data_Tedad,'Numero de hijos'=data_numero_hijos,'Porcentaje de Pobreza'=data_pobreza,'Dias en la Empresa'=data_dias_empresa, 'Distancia que recorre en metros'=data_distancia) %>%
tab_stat_mean() %>%
tab_cells('Otros Bonos'=data_otros_bono,'Numero de Lotes'=data_n_lote,'Numero de fundos'=data_n_fundo,'Numero de variedad'=data_n_variedad) %>%
tab_stat_median() %>%
tab_cells('Importe unico'=data_import_unico,'Importe Horas extra'=data_sum_hora_extra,'Bono total'=data_sum_aux_bono_total,
'Bono Produccion'=data_bono_produc,'Otros bonos'=data_otros_bono) %>%
tab_stat_mean() %>%
tab_cells('Bancarizado'=data_BANCARIZADO) %>%
tab_stat_mean() %>%
tab_cells('Peor calificación'=data_PEOR_CALIF_U6M,'Moda de Calificación'=data_MODA_CALIF_U6M,data_TIPCRE_UM) %>%
tab_stat_cpct(total_row_position = "above") %>%
tab_cells('Deuda Promedio'=data_DEUDA_PROM_U6M,'Promedio de Dias de atraso'=data_NRO_ENT_PROM_U6M,'Promedio de Dias de atraso'=data_DIAS_ATRASO_PROM_U6M) %>%
tab_stat_mean() %>%
tab_pivot() %>%
set_caption("Tabla describe cluster")
masteripr_g1 %>% mutate(clus_camp=paste(cluster,'-',data_Tcamp)) %>% tab_cols(total(),clus_camp) %>% tab_cells('Importe unico'=data_import_unico,'Importe Horas extra'=data_sum_hora_extra,'Bono total'=data_sum_aux_bono_total,
'Bono Produccion'=data_bono_produc,'Otros bonos'=data_otros_bono) %>%
tab_stat_mean() %>%
tab_pivot() %>%
set_caption("Tabla describe cluster")
write.csv(masteripr_g1,'raleo_base_clus_4clusteres.csv',row.names=FALSE)
| Tabla describe cluster | ||||||||
| #Total | cluster | |||||||
|---|---|---|---|---|---|---|---|---|
| 1 | 2 | 3 | 4 | |||||
| Sede | #Total cases | 23115 | 573 | 5793 | 3247 | 13502 | ||
| Ica | 45.1 | 70.3 | 47.2 | 32.3 | 46.2 | |||
| Piura | 54.9 | 29.7 | 52.8 | 67.7 | 53.8 | |||
| Productividad | Median | 22.7 | 33.9 | 33.7 | 34.6 | 16.4 | ||
| Producción | Median | 788.0 | 815.0 | 6332.0 | 13052.0 | 266.0 | ||
| Horas Laboraras | Median | 76.5 | 45.0 | 187.8 | 375.5 | 27.2 | ||
| Productividad | Max. | 238.5 | 149.3 | 224.1 | 203.6 | 238.5 | ||
| Producción | Max. | 96681.0 | 40975.0 | 58406.0 | 96681.0 | 25096.0 | ||
| Horas Laboraras | Max. | 836.5 | 580.5 | 494.0 | 836.5 | 251.5 | ||
| Productividad | Min. | 0.1 | 0.4 | 0.3 | 0.5 | 0.1 | ||
| Producción | Min. | 1.0 | 3.0 | 4.0 | 73.0 | 1.0 | ||
| Horas Laboraras | Min. | 0.2 | 2.0 | 8.0 | 61.5 | 0.2 | ||
| Sexo | #Total cases | 23115 | 573 | 5793 | 3247 | 13502 | ||
| Hombre | 46.2 | 58.3 | 41.0 | 41.6 | 49.0 | |||
| Mujer | 53.8 | 41.7 | 59.0 | 58.4 | 51.0 | |||
| Rango de edades | #Total cases | 23115 | 573 | 5793 | 3247 | 13502 | ||
| DE 31 A 50 | 44.0 | 74.2 | 46.6 | 48.5 | 40.5 | |||
| MAS DE 50 | 4.7 | 13.6 | 4.6 | 4.5 | 4.4 | |||
| MENOR A 30 | 51.3 | 12.2 | 48.9 | 47.0 | 55.1 | |||
| Grado de Instruccion | #Total cases | 18840 | 573 | 4909 | 2738 | 10620 | ||
| EDUCACION ESPECIAL | 0.0 | 0.0 | ||||||
| ILETRADO | 2.5 | 1.9 | 2.1 | 4.3 | 2.2 | |||
| PRIMARIA COMPLETA | 14.4 | 17.1 | 14.4 | 18.7 | 13.2 | |||
| PRIMARIA INCOMPLETA | 9.7 | 6.1 | 10.3 | 13.5 | 8.6 | |||
| SECUNDARIA COMPLETA | 40.8 | 49.9 | 40.7 | 34.8 | 41.9 | |||
| SECUNDARIA IMCOMPLETA | 31.0 | 19.2 | 30.9 | 27.6 | 32.5 | |||
| SUPERIOR - TECNICO | 1.6 | 5.8 | 1.5 | 1.1 | 1.6 | |||
| Estado Civil | #Total cases | 23115 | 573 | 5793 | 3247 | 13502 | ||
| Casado(a)/conviviente/unionlibre | 7.9 | 20.8 | 7.9 | 10.4 | 6.7 | |||
| Divorciado(a)/separado(a) | 0.1 | 0.1 | 0.1 | 0.1 | ||||
| Soltero(a) | 91.9 | 79.2 | 91.9 | 89.3 | 93.1 | |||
| Viudo(a) | 0.1 | 0.1 | 0.2 | 0.1 | ||||
| Tenencia de Hijos | #Total cases | 23115 | 573 | 5793 | 3247 | 13502 | ||
| con hijos | 52.1 | 26.0 | 63.9 | 70.9 | 43.5 | |||
| sin hijos | 47.9 | 74.0 | 36.1 | 29.1 | 56.5 | |||
| Cantidad de Campañas | #Total cases | 23115 | 573 | 5793 | 3247 | 13502 | ||
| 1 | 51.9 | 4.0 | 41.5 | 26.2 | 64.6 | |||
| 2 | 22.9 | 8.2 | 26.1 | 28.4 | 20.9 | |||
| 3 | 11.5 | 14.8 | 15.3 | 21.0 | 7.5 | |||
| 4 | 7.9 | 27.2 | 10.1 | 14.6 | 4.5 | |||
| 5 | 5.7 | 45.7 | 7.0 | 9.8 | 2.5 | |||
| Edad | Mean | 31.8 | 40.3 | 32.2 | 32.4 | 31.0 | ||
| Numero de hijos | Mean | 0.7 | 0.4 | 0.9 | 1.0 | 0.6 | ||
| Porcentaje de Pobreza | Mean | 32.8 | 34.8 | 33.3 | 32.4 | 32.6 | ||
| Dias en la Empresa | Mean | 257.5 | 2981.2 | 186.6 | 225.9 | 179.9 | ||
| Distancia que recorre en metros | Mean | 94220.0 | 18581.8 | 81017.9 | 58630.7 | 113818.6 | ||
| Otros Bonos | Median | 0.0 | 1.3 | 0.0 | 0.0 | 0.0 | ||
| Numero de Lotes | Median | 4.0 | 3.0 | 8.0 | 16.0 | 2.0 | ||
| Numero de fundos | Median | 2.0 | 2.0 | 3.0 | 4.0 | 1.0 | ||
| Numero de variedad | Median | 2.0 | 1.0 | 3.0 | 4.0 | 1.0 | ||
| Importe unico | Mean | 545.1 | 402.0 | 825.2 | 1662.2 | 162.3 | ||
| Importe Horas extra | Mean | 9.8 | 28.3 | 16.4 | 18.1 | 4.2 | ||
| Bono total | Mean | 315.3 | 190.2 | 555.0 | 893.4 | 78.8 | ||
| Bono Produccion | Mean | 262.5 | 181.9 | 473.9 | 744.1 | 59.3 | ||
| Otros bonos | Mean | 1.4 | 18.0 | 1.3 | 0.6 | 0.9 | ||
| Bancarizado | Mean | 0.7 | 0.9 | 0.8 | 0.8 | 0.7 | ||
| Peor calificación | #Total cases | 23112 | 573 | 5793 | 3247 | 13499 | ||
| 0.NORMAL | 21.0 | 46.4 | 21.5 | 23.0 | 19.2 | |||
| 1.CPP | 4.0 | 4.4 | 4.2 | 3.5 | 4.0 | |||
| 2.DEFICIENTE | 1.8 | 2.1 | 1.9 | 1.8 | 1.8 | |||
| 3.DUDOSO | 2.6 | 1.9 | 2.7 | 2.7 | 2.6 | |||
| 4.EN PERDIDA | 23.5 | 16.4 | 23.0 | 20.5 | 24.8 | |||
| 8.SIN CALIFICACION | 47.0 | 28.8 | 46.7 | 48.4 | 47.6 | |||
| Moda de Calificación | #Total cases | 12191 | 406 | 3071 | 1670 | 7044 | ||
| 0.NORMAL | 52.7 | 75.6 | 54.1 | 59.1 | 49.2 | |||
| 1.CPP | 2.2 | 2.0 | 2.0 | 1.9 | 2.4 | |||
| 2.DEFICIENTE | 1.3 | 0.5 | 1.6 | 1.0 | 1.3 | |||
| 3.DUDOSO | 3.5 | 2.2 | 3.3 | 2.7 | 3.9 | |||
| 4.EN PERDIDA | 40.3 | 19.7 | 39.1 | 35.3 | 43.2 | |||
| data_TIPCRE_UM | #Total cases | 8528 | 347 | 2199 | 1206 | 4776 | ||
| CONSUMO NO REVOLVENTE | 49.5 | 76.7 | 48.7 | 49.3 | 48.0 | |||
| CONSUMO REVOLVENTE | 10.8 | 14.1 | 10.6 | 9.5 | 11.0 | |||
| HIPOTECARIOS PARA VIVIENDA | 0.4 | 0.3 | 0.5 | 0.5 | ||||
| MICROEMPRESAS | 37.8 | 8.4 | 39.0 | 39.6 | 39.0 | |||
| PEQUENAS EMPRESAS | 1.5 | 0.6 | 1.3 | 1.6 | 1.6 | |||
| Deuda Promedio | Mean | 4033.0 | 7702.3 | 4018.0 | 3694.2 | 3868.7 | ||
| Promedio de Dias de atraso | Mean | 1.5 | 1.6 | 1.5 | 1.4 | 1.5 | ||
| 62.2 | 70.3 | 72.2 | 49.3 | 60.2 | ||||
| Tabla describe cluster | ||||||||||||
| #Total | clus_camp | |||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 - 19 | 1 - 20 | 2 - 19 | 2 - 20 | 3 - 19 | 3 - 20 | 4 - 19 | 4 - 20 | |||||
| Importe unico | Mean | 545.1 | 446.2 | 349.9 | 830.5 | 819.3 | 1699.1 | 1606.9 | 179.9 | 146.0 | ||
| Importe Horas extra | Mean | 9.8 | 16.1 | 42.7 | 12.8 | 20.4 | 19.7 | 15.7 | 3.4 | 4.9 | ||
| Bono total | Mean | 315.3 | 181.3 | 200.6 | 467.7 | 650.9 | 882.0 | 910.7 | 87.1 | 71.1 | ||
| Bono Produccion | Mean | 262.5 | 159.6 | 208.1 | 353.9 | 605.6 | 795.7 | 666.8 | 56.2 | 62.2 | ||
| Otros bonos | Mean | 1.4 | 21.6 | 13.8 | 1.1 | 1.5 | 0.9 | 0.3 | 0.9 | 1.0 | ||
# CON 5 CLUSTERES
set.seed(1234)
km <- kmeans(masteripr_g11, 5, iter.max = 1000, nstart=10)
paste("SS between cluster=", (km$betweens/km$totss) *100, "%")
# Para la validación de los cluster usamos Análisis discriminante
scores_cluster <- km$cluster %>% as.data.frame()
colnames(scores_cluster) <- c("cluster")
masteripr_g11_final <- cbind(masteripr_g11,scores_cluster) %>% as.data.frame()
modelo_lda <- lda(cluster~., data=masteripr_g11_final)
n <- ncol(masteripr_g11_final)
predicciones <- predict(object = modelo_lda, newdata=masteripr_g11_final[,-n])
#table(masteripr_g11_final$cluster, predicciones$class, dnn=c("Clase real", "Clase predicha"))
training_error <- mean(masteripr_g11_final$cluster != predicciones$class)*100
paste("Error de classification=", training_error, "%")
# Análisis de correlación
# Visualización de las soluciones usando ACP
library(factoextra)
fviz_cluster(km,data=masteripr_g11_final,ellipse.type = "convex") +
theme_classic()
corrplot(cor(masteripr_g11), order = "hclust", tl.col='black', tl.cex=1) #Gráfico de las correlaciones
masteripr_g11_final <- masteripr_g11 %>% mutate(cluster=km$cluster )
masteripr_g1$cluster <- masteripr_g11_final$cluster
masteripr_g1 %>% tab_cols(total(),cluster) %>% tab_cells('Sede'=sede_cod) %>% tab_stat_cpct(total_row_position = "above")%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
tab_stat_median()%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
tab_stat_max()%>%tab_cells('Productividad'=data_productividad_per,'Producción'=data_sumCOD,'Horas Laboraras'=data_sumHRSLB) %>%
tab_stat_min() %>%tab_cells('Sexo'=data_Tsexo,'Rango de edades'=data_T_RangoEdad,'Grado de Instruccion'=data_GRADO2,'Estado Civil'=data_Testado_civil,'Tenencia de Hijos'=data_T_numero_hijos,'Cantidad de Campañas'=data_veces) %>% tab_stat_cpct(total_row_position = "above") %>%
tab_cells('Edad'=data_Tedad,'Numero de hijos'=data_numero_hijos,'Porcentaje de Pobreza'=data_pobreza,'Dias en la Empresa'=data_dias_empresa, 'Distancia que recorre en metros'=data_distancia) %>%
tab_stat_mean() %>%
tab_cells('Otros Bonos'=data_otros_bono,'Numero de Lotes'=data_n_lote,'Numero de fundos'=data_n_fundo,'Numero de variedad'=data_n_variedad) %>%
tab_stat_median() %>%
tab_cells('Importe unico'=data_import_unico,'Importe Horas extra'=data_sum_hora_extra,'Bono total'=data_sum_aux_bono_total,
'Bono Produccion'=data_bono_produc,'Otros bonos'=data_otros_bono) %>%
tab_stat_mean() %>%
tab_cells('Bancarizado'=data_BANCARIZADO) %>%
tab_stat_mean() %>%
tab_cells('Peor calificación'=data_PEOR_CALIF_U6M,'Moda de Calificación'=data_MODA_CALIF_U6M,data_TIPCRE_UM) %>%
tab_stat_cpct(total_row_position = "above") %>%
tab_cells('Deuda Promedio'=data_DEUDA_PROM_U6M,'Promedio de Dias de atraso'=data_NRO_ENT_PROM_U6M,'Promedio de Dias de atraso'=data_DIAS_ATRASO_PROM_U6M) %>%
tab_stat_mean() %>%
tab_pivot() %>%
set_caption("Tabla describe cluster")
masteripr_g1 %>% mutate(clus_camp=paste(cluster,'-',data_Tcamp)) %>% tab_cols(total(),clus_camp) %>% tab_cells('Importe unico'=data_import_unico,'Importe Horas extra'=data_sum_hora_extra,'Bono total'=data_sum_aux_bono_total,
'Bono Produccion'=data_bono_produc,'Otros bonos'=data_otros_bono) %>%
tab_stat_mean() %>%
tab_pivot() %>%
set_caption("Tabla describe cluster")
write.csv(masteripr_g1,'raleo_base_clus_5clusteres.csv',row.names=FALSE)
| Tabla describe cluster | |||||||||
| #Total | cluster | ||||||||
|---|---|---|---|---|---|---|---|---|---|
| 1 | 2 | 3 | 4 | 5 | |||||
| Sede | #Total cases | 23115 | 3236 | 519 | 5748 | 13337 | 275 | ||
| Ica | 45.1 | 32.3 | 67.4 | 47.2 | 46.0 | 71.6 | |||
| Piura | 54.9 | 67.7 | 32.6 | 52.8 | 54.0 | 28.4 | |||
| Productividad | Median | 22.7 | 34.6 | 30.7 | 33.7 | 16.3 | 34.2 | ||
| Producción | Median | 788.0 | 13052.0 | 626.0 | 6332.0 | 265.0 | 964.0 | ||
| Horas Laboraras | Median | 76.5 | 375.5 | 34.2 | 188.0 | 27.5 | 49.0 | ||
| Productividad | Max. | 238.5 | 203.6 | 123.7 | 224.1 | 238.5 | 149.3 | ||
| Producción | Max. | 96681.0 | 96681.0 | 30463.0 | 58406.0 | 25096.0 | 40975.0 | ||
| Horas Laboraras | Max. | 836.5 | 836.5 | 580.5 | 494.0 | 251.5 | 557.5 | ||
| Productividad | Min. | 0.1 | 0.5 | 0.4 | 0.3 | 0.1 | 0.4 | ||
| Producción | Min. | 1.0 | 73.0 | 3.0 | 4.0 | 1.0 | 3.0 | ||
| Horas Laboraras | Min. | 0.2 | 61.5 | 2.0 | 8.0 | 0.2 | 2.5 | ||
| Sexo | #Total cases | 23115 | 3236 | 519 | 5748 | 13337 | 275 | ||
| Hombre | 46.2 | 41.6 | 46.2 | 41.0 | 49.3 | 60.4 | |||
| Mujer | 53.8 | 58.4 | 53.8 | 59.0 | 50.7 | 39.6 | |||
| Rango de edades | #Total cases | 23115 | 3236 | 519 | 5748 | 13337 | 275 | ||
| DE 31 A 50 | 44.0 | 48.3 | 69.7 | 46.4 | 40.2 | 75.6 | |||
| MAS DE 50 | 4.7 | 4.5 | 6.6 | 4.6 | 4.4 | 18.9 | |||
| MENOR A 30 | 51.3 | 47.2 | 23.7 | 49.0 | 55.4 | 5.5 | |||
| Grado de Instruccion | #Total cases | 18840 | 2727 | 513 | 4865 | 10460 | 275 | ||
| EDUCACION ESPECIAL | 0.0 | 0.0 | |||||||
| ILETRADO | 2.5 | 4.3 | 1.4 | 2.1 | 2.2 | 2.5 | |||
| PRIMARIA COMPLETA | 14.4 | 18.7 | 13.5 | 14.4 | 13.2 | 18.2 | |||
| PRIMARIA INCOMPLETA | 9.7 | 13.5 | 5.1 | 10.3 | 8.7 | 6.2 | |||
| SECUNDARIA COMPLETA | 40.8 | 34.8 | 48.9 | 40.8 | 41.8 | 50.5 | |||
| SECUNDARIA IMCOMPLETA | 31.0 | 27.6 | 27.7 | 30.9 | 32.5 | 14.9 | |||
| SUPERIOR - TECNICO | 1.6 | 1.1 | 3.5 | 1.6 | 1.5 | 7.6 | |||
| Estado Civil | #Total cases | 23115 | 3236 | 519 | 5748 | 13337 | 275 | ||
| Casado(a)/conviviente/unionlibre | 7.9 | 10.4 | 15.4 | 7.9 | 6.6 | 27.3 | |||
| Divorciado(a)/separado(a) | 0.1 | 0.1 | 0.1 | 0.1 | |||||
| Soltero(a) | 91.9 | 89.4 | 84.6 | 91.9 | 93.2 | 72.7 | |||
| Viudo(a) | 0.1 | 0.2 | 0.1 | 0.1 | |||||
| Tenencia de Hijos | #Total cases | 23115 | 3236 | 519 | 5748 | 13337 | 275 | ||
| con hijos | 52.1 | 70.9 | 35.5 | 64.1 | 43.6 | 18.2 | |||
| sin hijos | 47.9 | 29.1 | 64.5 | 35.9 | 56.4 | 81.8 | |||
| Cantidad de Campañas | #Total cases | 23115 | 3236 | 519 | 5748 | 13337 | 275 | ||
| 1 | 51.9 | 26.3 | 4.4 | 41.7 | 65.4 | 4.4 | |||
| 2 | 22.9 | 28.4 | 9.6 | 26.3 | 21.0 | 6.5 | |||
| 3 | 11.5 | 21.1 | 15.8 | 15.3 | 7.3 | 15.6 | |||
| 4 | 7.9 | 14.5 | 28.9 | 10.0 | 4.1 | 27.6 | |||
| 5 | 5.7 | 9.7 | 41.2 | 6.7 | 2.1 | 45.8 | |||
| Edad | Mean | 31.8 | 32.4 | 37.1 | 32.2 | 31.0 | 42.3 | ||
| Numero de hijos | Mean | 0.7 | 1.0 | 0.6 | 0.9 | 0.6 | 0.3 | ||
| Porcentaje de Pobreza | Mean | 32.8 | 32.4 | 35.3 | 33.3 | 32.6 | 33.8 | ||
| Dias en la Empresa | Mean | 257.5 | 222.5 | 1783.9 | 179.7 | 166.2 | 3841.3 | ||
| Distancia que recorre en metros | Mean | 94220.0 | 58805.4 | 34180.1 | 81298.6 | 114809.8 | 14069.0 | ||
| Otros Bonos | Median | 0.0 | 0.0 | 0.9 | 0.0 | 0.0 | 2.9 | ||
| Numero de Lotes | Median | 4.0 | 16.0 | 3.0 | 8.0 | 2.0 | 3.0 | ||
| Numero de fundos | Median | 2.0 | 4.0 | 2.0 | 3.0 | 1.0 | 2.0 | ||
| Numero de variedad | Median | 2.0 | 4.0 | 1.0 | 3.0 | 1.0 | 1.0 | ||
| Importe unico | Mean | 545.1 | 1663.1 | 346.5 | 826.6 | 162.7 | 425.8 | ||
| Importe Horas extra | Mean | 9.8 | 18.0 | 26.4 | 16.4 | 4.0 | 26.0 | ||
| Bono total | Mean | 315.3 | 893.7 | 157.1 | 557.0 | 79.5 | 196.5 | ||
| Bono Produccion | Mean | 262.5 | 743.9 | 151.8 | 475.8 | 59.7 | 183.0 | ||
| Otros bonos | Mean | 1.4 | 0.6 | 14.5 | 1.2 | 0.8 | 22.1 | ||
| Bancarizado | Mean | 0.7 | 0.8 | 0.9 | 0.8 | 0.7 | 0.9 | ||
| Peor calificación | #Total cases | 23112 | 3236 | 519 | 5748 | 13334 | 275 | ||
| 0.NORMAL | 21.0 | 23.0 | 39.3 | 21.4 | 19.0 | 50.9 | |||
| 1.CPP | 4.0 | 3.6 | 3.7 | 4.2 | 4.0 | 4.7 | |||
| 2.DEFICIENTE | 1.8 | 1.8 | 4.0 | 1.9 | 1.8 | 1.5 | |||
| 3.DUDOSO | 2.6 | 2.8 | 1.7 | 2.7 | 2.6 | 2.9 | |||
| 4.EN PERDIDA | 23.5 | 20.5 | 20.6 | 22.9 | 24.8 | 15.6 | |||
| 8.SIN CALIFICACION | 47.0 | 48.5 | 30.6 | 46.9 | 47.8 | 24.4 | |||
| Moda de Calificación | #Total cases | 12191 | 1661 | 356 | 3037 | 6929 | 208 | ||
| 0.NORMAL | 52.7 | 59.0 | 70.8 | 54.1 | 48.8 | 77.9 | |||
| 1.CPP | 2.2 | 1.9 | 2.0 | 1.9 | 2.4 | 1.9 | |||
| 2.DEFICIENTE | 1.3 | 1.0 | 1.1 | 1.6 | 1.3 | 1.0 | |||
| 3.DUDOSO | 3.5 | 2.7 | 1.7 | 3.3 | 4.0 | 1.9 | |||
| 4.EN PERDIDA | 40.3 | 35.4 | 24.4 | 39.1 | 43.5 | 17.3 | |||
| data_TIPCRE_UM | #Total cases | 8528 | 1199 | 291 | 2178 | 4678 | 182 | ||
| CONSUMO NO REVOLVENTE | 49.5 | 49.3 | 67.7 | 48.5 | 47.6 | 82.4 | |||
| CONSUMO REVOLVENTE | 10.8 | 9.4 | 18.6 | 10.4 | 10.7 | 14.3 | |||
| HIPOTECARIOS PARA VIVIENDA | 0.4 | 0.3 | 0.5 | 0.5 | |||||
| MICROEMPRESAS | 37.8 | 39.7 | 11.0 | 39.3 | 39.7 | 3.3 | |||
| PEQUENAS EMPRESAS | 1.5 | 1.6 | 2.4 | 1.3 | 1.5 | ||||
| Deuda Promedio | Mean | 4033.0 | 3664.6 | 7576.0 | 4030.9 | 3765.7 | 8040.6 | ||
| Promedio de Dias de atraso | Mean | 1.5 | 1.4 | 1.7 | 1.5 | 1.5 | 1.6 | ||
| 62.2 | 49.6 | 61.3 | 72.5 | 61.2 | 46.7 | ||||
| Tabla describe cluster | ||||||||||||||
| #Total | clus_camp | |||||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 - 19 | 1 - 20 | 2 - 19 | 2 - 20 | 3 - 19 | 3 - 20 | 4 - 19 | 4 - 20 | 5 - 19 | 5 - 20 | |||||
| Importe unico | Mean | 545.1 | 1700.0 | 1607.8 | 392.4 | 287.8 | 832.9 | 819.7 | 180.4 | 146.2 | 454.4 | 391.4 | ||
| Importe Horas extra | Mean | 9.8 | 19.7 | 15.5 | 10.4 | 46.7 | 12.8 | 20.3 | 3.4 | 4.5 | 18.9 | 34.6 | ||
| Bono total | Mean | 315.3 | 883.1 | 909.7 | 141.9 | 176.5 | 469.0 | 652.9 | 88.6 | 71.0 | 192.7 | 201.1 | ||
| Bono Produccion | Mean | 262.5 | 796.7 | 664.7 | 124.7 | 186.3 | 354.9 | 607.4 | 57.2 | 62.0 | 165.2 | 204.4 | ||
| Otros bonos | Mean | 1.4 | 0.7 | 0.3 | 16.8 | 11.6 | 0.9 | 1.4 | 0.6 | 0.9 | 27.5 | 15.5 | ||
# CUARDANDO LA DATA
write.csv(masterip_g1,'cosecha_base_clus.csv',row.names=FALSE)
write.csv(masteripr_g1,'raleo_base_clus.csv',row.names=FALSE)
masteripr_g1<-masteripr_g1 %>% mutate(q1 = ntile(data_productividad_per,3)) %>% mutate(productividad_cat=case_when(q1=='1'~'BAJO',q1=='2'~'MEDIO',q1=='3'~'ALTO',TRUE ~ 'OTRO')) %>% dplyr::select(-q1)
masteripr_g1<-masteripr_g1%>% dplyr::select(
data_GRADO2,
data_sum_variedad_total_AL,
data_sum_variedad_total_CC,
data_sum_variedad_total_CP,
data_sum_variedad_total_JS,
data_sum_variedad_total_MG,
data_sum_variedad_total_RG,
data_sum_variedad_total_SG,
data_sum_variedad_total_TC,
data_sum_variedad_total_TM,
data_sum_variedad_total_VN,
data_sum_aux_bono_total,
data_sum_hora_extra,
data_n_lote,
data_n_fundo,
data_Testado_civil,
data_Tsexo,
data_dias_empresa,
data_Tedad,
data_numero_hijos,
data_pobreza,
data_n_variedad,
data_veces,
data_DEUDA_PROM_U6M,
data_PEOR_CALIF_U6M,
data_MODA_CALIF_U6M,
data_NRO_ENT_PROM_U6M,
data_TIPCRE_UM,
data_DIAS_ATRASO_PROM_U6M,
data_BANCARIZADO,
data_distancia,
data_import_unico,
data_bono_produc,
data_otros_bono,
dummies_Tsexo_Mujer,sede_cod,data_numero_asistentes,
data_asistente_mediana_Tedad,
data_asistente_mediana_numero_hijos,
data_asistente_dias_empresa,cluster,productividad_cat)
####################################################
# ÁRBOL DE CLASIFICACIÓN CON EL ALGORITMO CART #
####################################################
set.seed(123)
arbol_1 <- rpart(factor(productividad_cat)~.,
data=masteripr_g1,
method="class",
parms=list(split='gini'))
#Graficando el árbol
rpart.plot(arbol_1, digits=-1, type=0, extra=102,cex = .7, nn=TRUE)
rpart.plot(arbol_1, digits=-1, type=1, extra=106,cex = .7, nn=TRUE)
rpart.plot(arbol_1, digits=-1, type=2, extra=102,cex = .7, nn=TRUE)
rpart.plot(arbol_1, digits=-1, type=3, extra=105,cex = .7, nn=TRUE)
rpart.plot(arbol_1, digits=-1, type=4, extra=105,cex = .7, nn=TRUE)
#library(caret)
#varImp(arbol_1)
# Mejorando los Gráficos
plot(as.party(arbol_1), tp_args = list(id = FALSE))
####################################################
# CART CON CARET Y VALIDACIÓN CRUZADA REPETIDA #
####################################################
Warning message: “extra=106 but the response has 3 levels (only the 2nd level is displayed)”